From 021b5f06d3900fe2b10d5d3ccf6ac286a779ef16 Mon Sep 17 00:00:00 2001
From: hallgren <hallgren@chalmers.se>
Date: Thu, 19 Sep 2013 20:48:10 +0000
Subject: 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.
---
 src/compiler/GF/Infra/Dependencies.hs |  2 +-
 src/compiler/GF/Infra/Ident.hs        | 57 +++++++++++++++++++++++------------
 2 files changed, 38 insertions(+), 21 deletions(-)

(limited to 'src/compiler/GF/Infra')

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'
 
-- 
cgit v1.2.3