Introduce type RawIdent; only 9 imports of Data.ByteString.Char8 remain

The fact that identifiers are represented as ByteStrings is now an internal
implentation detail in module GF.Infra.Ident. Conversion between ByteString
and identifiers is only needed in the lexer and the Binary instances.
This commit is contained in:
hallgren
2013-09-19 20:48:10 +00:00
parent 3d5b9bd1fd
commit 021b5f06d3
14 changed files with 74 additions and 64 deletions

View File

@@ -17,6 +17,9 @@ module GF.Infra.Ident (-- * Identifiers
identS, identC, identV, identA, identAV, identW,
argIdent, isArgIdent, getArgIndex,
varStr, varX, isWildIdent, varIndex,
-- * Raw Identifiers
RawIdent, rawIdentS, rawIdentC, ident2raw, prefixRawIdent,
isPrefixOf, showRawIdent, rawId2bs,
-- * refreshing identifiers
IdState, initIdStateN, initIdState,
lookVar, refVar, refVarPlus
@@ -31,25 +34,37 @@ import Text.PrettyPrint
-- | the constructors labelled /INTERNAL/ are
-- internal representation never returned by the parser
data Ident =
IC {-# UNPACK #-} !BS.ByteString -- ^ raw identifier after parsing, resolved in Rename
| IW -- ^ wildcard
IC {-# UNPACK #-} !RawIdent -- ^ raw identifier after parsing, resolved in Rename
| IW -- ^ wildcard
--
-- below this constructor: internal representation never returned by the parser
| IV {-# UNPACK #-} !BS.ByteString {-# UNPACK #-} !Int -- ^ /INTERNAL/ variable
| IA {-# UNPACK #-} !BS.ByteString {-# UNPACK #-} !Int -- ^ /INTERNAL/ argument of cat at position
| IAV {-# UNPACK #-} !BS.ByteString {-# UNPACK #-} !Int {-# UNPACK #-} !Int -- ^ /INTERNAL/ argument of cat with bindings at position
| IV {-# UNPACK #-} !RawIdent {-# UNPACK #-} !Int -- ^ /INTERNAL/ variable
| IA {-# UNPACK #-} !RawIdent {-# UNPACK #-} !Int -- ^ /INTERNAL/ argument of cat at position
| IAV {-# UNPACK #-} !RawIdent {-# UNPACK #-} !Int {-# UNPACK #-} !Int -- ^ /INTERNAL/ argument of cat with bindings at position
--
deriving (Eq, Ord, Show, Read)
newtype RawIdent = Id { rawId2bs :: BS.ByteString }
deriving (Eq, Ord, Show, Read)
rawIdentS = Id . BS.pack
rawIdentC = Id
showRawIdent = BS.unpack . rawId2bs
prefixRawIdent (Id x) (Id y) = Id (BS.append x y)
isPrefixOf (Id x) (Id y) = BS.isPrefixOf x y
ident2bs :: Ident -> BS.ByteString
ident2bs i = case i of
IC s -> s
IV s n -> BS.append s (BS.pack ('_':show n))
IA s j -> BS.append s (BS.pack ('_':show j))
IAV s b j -> BS.append s (BS.pack ('_':show b ++ '_':show j))
IC (Id s) -> s
IV (Id s) n -> BS.append s (BS.pack ('_':show n))
IA (Id s) j -> BS.append s (BS.pack ('_':show j))
IAV (Id s) b j -> BS.append s (BS.pack ('_':show b ++ '_':show j))
IW -> BS.pack "_"
ident2raw = Id . ident2bs
showIdent :: Ident -> String
showIdent i = BS.unpack $! ident2bs i
@@ -57,19 +72,19 @@ ppIdent :: Ident -> Doc
ppIdent = text . showIdent
identS :: String -> Ident
identS = identC . BS.pack
identS = identC . rawIdentS
identC :: BS.ByteString -> Ident
identV :: BS.ByteString -> Int -> Ident
identA :: BS.ByteString -> Int -> Ident
identAV:: BS.ByteString -> Int -> Int -> Ident
identC :: RawIdent -> Ident
identV :: RawIdent -> Int -> Ident
identA :: RawIdent -> Int -> Ident
identAV:: RawIdent -> Int -> Int -> Ident
identW :: Ident
(identC, identV, identA, identAV, identW) =
(IC, IV, IA, IAV, IW)
prefixIdent :: String -> Ident -> Ident
prefixIdent pref = identC . BS.append (BS.pack pref) . ident2bs
prefixIdent pref = identC . Id . BS.append (BS.pack pref) . ident2bs
-- normal identifier
-- ident s = IC s
@@ -85,24 +100,26 @@ isArgIdent _ = False
getArgIndex (IA _ i) = Just i
getArgIndex (IAV _ _ i) = Just i
getArgIndex (IC s)
getArgIndex (IC (Id s))
| isDigit (BS.last s) = (Just . read . BS.unpack . snd . BS.spanEnd isDigit) s
getArgIndex x = Nothing
-- | used in lin defaults
varStr :: Ident
varStr = identA (BS.pack "str") 0
varStr = identA (rawIdentS "str") 0
-- | refreshing variables
varX :: Int -> Ident
varX = identV (BS.pack "x")
varX = identV (rawIdentS "x")
isWildIdent :: Ident -> Bool
isWildIdent x = case x of
IW -> True
IC s | s == BS.pack "_" -> True
IC s | s == wild -> True
_ -> False
wild = Id (BS.pack "_")
varIndex :: Ident -> Int
varIndex (IV _ n) = n
varIndex _ = -1 --- other than IV should not count
@@ -129,7 +146,7 @@ refVar :: Ident -> STM IdState Ident
----refVar IW = return IW --- no update of wildcard
refVar x = do
(_,m) <- readSTM
let x' = IV (ident2bs x) m
let x' = IV (ident2raw x) m
updateSTM (\(sys,mx) -> ((x, x'):sys, mx + 1))
return x'