summaryrefslogtreecommitdiff
path: root/src/compiler/GF/Infra
diff options
context:
space:
mode:
authorhallgren <hallgren@chalmers.se>2013-09-19 20:48:10 +0000
committerhallgren <hallgren@chalmers.se>2013-09-19 20:48:10 +0000
commit021b5f06d3900fe2b10d5d3ccf6ac286a779ef16 (patch)
treecff0a0ca9c945dcef34f58a6e09fc5042c7abd65 /src/compiler/GF/Infra
parent3d5b9bd1fd46a51651cbfbd45f03e5b878aebbac (diff)
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.
Diffstat (limited to 'src/compiler/GF/Infra')
-rw-r--r--src/compiler/GF/Infra/Dependencies.hs2
-rw-r--r--src/compiler/GF/Infra/Ident.hs57
2 files changed, 38 insertions, 21 deletions
diff --git a/src/compiler/GF/Infra/Dependencies.hs b/src/compiler/GF/Infra/Dependencies.hs
index d90cbbae6..8c3d6666f 100644
--- a/src/compiler/GF/Infra/Dependencies.hs
+++ b/src/compiler/GF/Infra/Dependencies.hs
@@ -3,7 +3,7 @@ module GF.Infra.Dependencies (
) where
import GF.Grammar.Grammar
-import GF.Infra.Ident
+import GF.Infra.Ident(Ident,showIdent)
import Data.List (nub,isPrefixOf)
diff --git a/src/compiler/GF/Infra/Ident.hs b/src/compiler/GF/Infra/Ident.hs
index bb26ea98c..102ceedd3 100644
--- a/src/compiler/GF/Infra/Ident.hs
+++ b/src/compiler/GF/Infra/Ident.hs
@@ -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'