diff options
author | Ben Gamari <ben@smart-cactus.org> | 2016-07-11 21:20:59 +0200 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2016-07-12 16:26:17 +0200 |
commit | 23649dd8a68f8ead0688f794d5d1d82219adad95 (patch) | |
tree | 88005894a5286b9b744c9f4c616aca70ada98fd2 | |
parent | f4de1552d6455d53fba89cde3b67e2307ecc82cc (diff) | |
download | haskell-23649dd8a68f8ead0688f794d5d1d82219adad95.tar.gz |
TysWiredIn: Switch back to parsing tuple names
-rw-r--r-- | compiler/prelude/TysWiredIn.hs | 51 |
1 files changed, 27 insertions, 24 deletions
diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs index 8465cd98a2..65abdd8f69 100644 --- a/compiler/prelude/TysWiredIn.hs +++ b/compiler/prelude/TysWiredIn.hs @@ -5,6 +5,7 @@ -} {-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} -- | This module is about types that can be defined in Haskell, but which -- must be wired into the compiler nonetheless. C.f module TysPrim @@ -134,7 +135,6 @@ import {-# SOURCE #-} ConLike import TyCon import Class ( Class, mkClass ) import RdrName -import UniqFM import Name import NameSet ( NameSet, mkNameSet, elemNameSet ) import BasicTypes ( Arity, Boxity(..), @@ -148,6 +148,8 @@ import Outputable import Util import BooleanFormula ( mkAnd ) +import qualified Data.ByteString.Char8 as BS + alpha_tyvar :: [TyVar] alpha_tyvar = [alphaTyVar] @@ -181,8 +183,7 @@ names in PrelNames, so they use wTcQual, wDataQual, etc -- define here. -- -- Because of their infinite nature, this list excludes tuples, Any and implicit --- parameter TyCons. Instead, we have a hack in lookupOrigNameCache to deal with --- these names. +-- parameter TyCons (see Note [Built-in syntax and the OrigNameCache]). -- -- See also Note [Known-key names] wiredInTyCons :: [TyCon] @@ -636,19 +637,30 @@ decl in GHC.Classes, so I think this part may not work properly. But it's unused I think. -} -builtInOccNames :: UniqFM (OccName -> Name) -builtInOccNames = listToUFM $ - [ (fsLit "[]", choose_ns listTyConName nilDataConName) - , (fsLit ":" , const consDataConName) - , (fsLit "[::]", const parrTyConName) - , (fsLit "()", tup_name Boxed 0) - , (fsLit "(##)", tup_name Unboxed 0) - ] ++ - [ (fsLit $ "("++replicate n ','++")", tup_name Boxed (n+1)) | n <- [1..62] ] ++ - [ (fsLit $ "(#"++replicate n ','++"#)", tup_name Unboxed (n+1)) | n <- [1..62] ] +isBuiltInOcc_maybe :: OccName -> Maybe Name +-- Built in syntax isn't "in scope" so these OccNames +-- map to wired-in Names with BuiltInSyntax +isBuiltInOcc_maybe occ = + case name of + "[]" -> Just $ choose_ns listTyConName nilDataConName + ":" -> Just consDataConName + "[::]" -> Just parrTyConName + "()" -> Just $ tup_name Boxed 0 + "(##)" -> Just $ tup_name Unboxed 0 + _ | Just rest <- name `BS.stripPrefix` "(" + , (commas, rest') <- BS.span (==',') rest + , ")" <- rest' + -> Just $ tup_name Boxed (1+BS.length commas) + _ | Just rest <- name `BS.stripPrefix` "(#" + , (commas, rest') <- BS.span (==',') rest + , "#)" <- rest' + -> Just $ tup_name Unboxed (1+BS.length commas) + _ -> Nothing where - choose_ns :: Name -> Name -> OccName -> Name - choose_ns tc dc occ + name = fastStringToByteString $ occNameFS occ + + choose_ns :: Name -> Name -> Name + choose_ns tc dc | isTcClsNameSpace ns = tc | isDataConNameSpace ns = dc | otherwise = pprPanic "tup_name" (ppr occ) @@ -658,15 +670,6 @@ builtInOccNames = listToUFM $ = choose_ns (getName (tupleTyCon boxity arity)) (getName (tupleDataCon boxity arity)) - -isBuiltInOcc_maybe :: OccName -> Maybe Name --- Built in syntax isn't "in scope" so these OccNames --- map to wired-in Names with BuiltInSyntax -isBuiltInOcc_maybe occ - = case lookupUFM builtInOccNames (occNameFS occ) of - Just f -> Just (f occ) - Nothing -> Nothing - mkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName -- No need to cache these, the caching is done in mk_tuple mkTupleOcc ns Boxed ar = mkOccName ns (mkBoxedTupleStr ar) |