msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

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

Browse Source 
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
Download Patch File Download Diff File Expand all files Collapse all files

5
src/compiler/GF/Command/Importing.hs
View File

@@ -5,7 +5,7 @@ import PGF.Data
import GF.Compile
import GF.Compile.Multi (readMulti)
import GF.Grammar (identC, SourceGrammar) -- for cc command
import GF.Grammar (identS, SourceGrammar) -- for cc command
import GF.Grammar.CF
import GF.Grammar.EBNF
import GF.Infra.UseIO
@@ -13,7 +13,6 @@ import GF.Infra.Option
import GF.Data.ErrM
import Data.List (nubBy)
import qualified Data.ByteString.Char8 as BS
import System.FilePath
-- import a grammar in an environment where it extends an existing grammar
@@ -59,7 +58,7 @@ importCF opts files get = do
Ok gf -> return gf
Bad s -> error s ----
Ok gr <- appIOE $ compileSourceGrammar opts gf
epgf <- appIOE $ link opts (identC (BS.pack (justModuleName (last files) ++ "Abs"))) gr
epgf <- appIOE $ link opts (identS (justModuleName (last files) ++ "Abs")) gr
case epgf of
Ok pgf -> return pgf
Bad s -> error s ----

3
src/compiler/GF/Compile.hs
View File

@@ -35,7 +35,6 @@ import qualified Data.Map as Map
--import qualified Data.Set as Set
import Data.List(nub)
import Data.Maybe (isNothing)
import qualified Data.ByteString.Char8 as BS
import Text.PrettyPrint
import PGF.CId
@@ -50,7 +49,7 @@ compileToPGF :: Options -> [FilePath] -> IOE PGF
compileToPGF opts fs =
do gr <- batchCompile opts fs
let name = justModuleName (last fs)
link opts (identC (BS.pack name)) gr
link opts (identS name) gr
link :: Options -> Ident -> SourceGrammar -> IOE PGF
link opts cnc gr = do

4
src/compiler/GF/Compile/GrammarToPGF.hs
View File

@@ -30,7 +30,6 @@ import Data.Char (isDigit,isSpace)
import qualified Data.Set as Set
import qualified Data.Map as Map
import qualified Data.IntMap as IntMap
import qualified Data.ByteString.Char8 as BS
import Data.Array.IArray
import Text.PrettyPrint
import Control.Monad.Identity
@@ -250,8 +249,7 @@ genCncFuns gr am cm seqs0 cdefs fid_cnt cnccats =
ctxt = mapM (mkCtxt lindefs) hargs_C
fids = map (mkFId arg_C) fid0s
mkLinDefId id =
identC (BS.append (BS.pack "lindef ") (ident2bs id))
mkLinDefId id = prefixIdent "lindef " id
toLinDef res offs lindefs (Production fid0 funid0 _) =
IntMap.insertWith (++) fid [offs+funid0] lindefs

9
src/compiler/GF/Compile/SubExOpt.hs
View File

@@ -32,8 +32,7 @@ import GF.Data.Operations
import Control.Monad
import Data.Map (Map)
import qualified Data.Map as Map
import qualified Data.ByteString.Char8 as BS
import Data.List
subexpModule :: SourceModule -> SourceModule
subexpModule (n,mo) = errVal (n,mo) $ do
@@ -133,9 +132,9 @@ collectSubterms mo t = case t of
return t --- only because of composOp
operIdent :: Int -> Ident
operIdent i = identC (operPrefix `BS.append` (BS.pack (show i))) ---
operIdent i = identC (operPrefix `prefixRawIdent` (rawIdentS (show i))) ---
isOperIdent :: Ident -> Bool
isOperIdent id = BS.isPrefixOf operPrefix (ident2bs id)
isOperIdent id = isPrefixOf operPrefix (ident2raw id)
operPrefix = BS.pack ("A''")
operPrefix = rawIdentS ("A''")

5
src/compiler/GF/Grammar/Binary.hs
View File

@@ -34,7 +34,7 @@ instance Binary Ident where
get = do bs <- get
if bs == BS.pack "_"
then return identW
else return (identC bs)
else return (identC (rawIdentC bs))
instance Binary SourceGrammar where
put = put . modules
@@ -289,6 +289,9 @@ instance Binary Label where
1 -> fmap LVar get
_ -> decodingError
instance Binary RawIdent where
put = put . rawId2bs
get = fmap rawIdentC get
putGFOVersion = mapM_ (putWord8 . fromIntegral . ord) gfoVersion
getGFOVersion = replicateM (length gfoVersion) (fmap (chr . fromIntegral) getWord8)

14
src/compiler/GF/Grammar/Grammar.hs
View File

@@ -74,7 +74,6 @@ import Data.Array.Unboxed
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.IntMap as IntMap
import qualified Data.ByteString.Char8 as BS
import Text.PrettyPrint
import System.FilePath
import Control.Monad.Identity
@@ -472,7 +471,7 @@ data TInfo =
-- | record label
data Label =
LIdent BS.ByteString
LIdent RawIdent
| LVar Int
deriving (Show, Eq, Ord)
@@ -497,16 +496,15 @@ varLabel :: Int -> Label
varLabel = LVar
tupleLabel, linLabel :: Int -> Label
tupleLabel i = LIdent $! BS.pack ('p':show i)
linLabel i = LIdent $! BS.pack ('s':show i)
tupleLabel i = LIdent $! rawIdentS ('p':show i)
linLabel i = LIdent $! rawIdentS ('s':show i)
theLinLabel :: Label
theLinLabel = LIdent (BS.singleton 's')
theLinLabel = LIdent (rawIdentS "s")
ident2label :: Ident -> Label
ident2label c = LIdent (ident2bs c)
ident2label c = LIdent (ident2raw c)
label2ident :: Label -> Ident
label2ident (LIdent s) = identC s
label2ident (LVar i) = identC (BS.pack ('$':show i))
label2ident (LVar i) = identS ('$':show i)

10
src/compiler/GF/Grammar/Lexer.hs
View File

@@ -278,12 +278,12 @@ getPosn :: P Posn
getPosn = P $ \inp@(AI pos _ _) -> POk pos
alex_action_3 = tok (eitherResIdent (T_Ident . identC))
alex_action_3 = tok (eitherResIdent (T_Ident . identC . rawIdentC))
alex_action_4 = tok (eitherResIdent (T_LString . BS.unpack))
alex_action_5 = tok (eitherResIdent (T_Ident . identC))
alex_action_6 = tok (T_String . unescapeInitTail . BS.unpack)
alex_action_7 = tok (T_Integer . read . BS.unpack)
alex_action_8 = tok (T_Double . read . BS.unpack)
alex_action_5 = tok (eitherResIdent (T_Ident . identC . rawIdentC))
alex_action_6 = tok (T_String . unescapeInitTail . BS.unpack)
alex_action_7 = tok (T_Integer . read . BS.unpack)
alex_action_8 = tok (T_Double . read . BS.unpack)
{-# LINE 1 "templates/GenericTemplate.hs" #-}
{-# LINE 1 "templates/GenericTemplate.hs" #-}
{-# LINE 1 "<built-in>" #-}

8
src/compiler/GF/Grammar/Lockfield.hs
View File

@@ -16,8 +16,6 @@
module GF.Grammar.Lockfield (lockRecType, unlockRecord, lockLabel, isLockLabel) where
import qualified Data.ByteString.Char8 as BS
import GF.Infra.Ident
import GF.Grammar.Grammar
import GF.Grammar.Macros
@@ -41,12 +39,12 @@ unlockRecord c ft = do
_ -> return $ mkAbs xs (ExtR t lock)
lockLabel :: Ident -> Label
lockLabel c = LIdent $! BS.append lockPrefix (ident2bs c)
lockLabel c = LIdent $! prefixRawIdent lockPrefix (ident2raw c)
isLockLabel :: Label -> Bool
isLockLabel l = case l of
LIdent c -> BS.isPrefixOf lockPrefix c
LIdent c -> isPrefixOf lockPrefix c
_ -> False
lockPrefix = BS.pack "lock_"
lockPrefix = rawIdentS "lock_"

11
src/compiler/GF/Grammar/MMacros.hs
View File

@@ -26,7 +26,6 @@ import GF.Grammar.Values
import GF.Grammar.Macros
import Control.Monad
import qualified Data.ByteString.Char8 as BS
import Text.PrettyPrint
{-
@@ -238,11 +237,11 @@ qualifTerm m = qualif [] where
Cn c -> Q (m,c)
Con c -> QC (m,c)
_ -> composSafeOp (qualif xs) t
chV x = string2var $ ident2bs x
chV x = string2var $ ident2raw x
string2var :: BS.ByteString -> Ident
string2var s = case BS.unpack s of
c:'_':i -> identV (BS.singleton c) (readIntArg i) ---
string2var :: RawIdent -> Ident
string2var s = case showRawIdent s of
c:'_':i -> identV (rawIdentS [c]) (readIntArg i) ---
_ -> identC s
-- | reindex variables so that they tell nesting depth level
@@ -254,7 +253,7 @@ reindexTerm = qualif (0,[]) where
Vr x -> Vr $ look x g
_ -> composSafeOp (qualif dg) t
look x = maybe x id . lookup x --- if x is not in scope it is unchanged
ind x d = identC $ ident2bs x `BS.append` BS.singleton '_' `BS.append` BS.pack (show d)
ind x d = identC $ ident2raw x `prefixRawIdent` rawIdentS "_" `prefixRawIdent` rawIdentS (show d)
{-
-- this method works for context-free abstract syntax

4
src/compiler/GF/Grammar/Parser.y
View File

@@ -507,11 +507,11 @@ Patt3
PattAss :: { [(Label,Patt)] }
PattAss
: ListIdent '=' Patt { [(LIdent (ident2bs i),$3) | i <- $1] }
: ListIdent '=' Patt { [(LIdent (ident2raw i),$3) | i <- $1] }
Label :: { Label }
Label
: Ident { LIdent (ident2bs $1) }
: Ident { LIdent (ident2raw $1) }
| '$' Integer { LVar (fromIntegral $2) }
Sort :: { Ident }

4
src/compiler/GF/Grammar/lexer/Lexer.x
View File

@@ -30,9 +30,9 @@ $u = [\0-\255] -- universal: any character
"{-" ([$u # \-] | \- [$u # \}])* ("-")+ "}" ;
$white+ ;
@rsyms { tok (eitherResIdent (T_Ident . identC)) }
@rsyms { tok (eitherResIdent (T_Ident . identC . rawIdentC)) }
\' ($u # \')* \' { tok (eitherResIdent (T_LString . BS.unpack)) }
(\_ | $l)($l | $d | \_ | \')* { tok (eitherResIdent (T_Ident . identC)) }
(\_ | $l)($l | $d | \_ | \')* { tok (eitherResIdent (T_Ident . identC . rawIdentC)) }
\" ([$u # [\" \\ \n]] | (\\ (\" | \\ | \' | n | t)))* \" { tok (T_String . unescapeInitTail . BS.unpack) }

2
src/compiler/GF/Infra/Dependencies.hs
View File

@@ -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)

57
src/compiler/GF/Infra/Ident.hs
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'

2
src/compiler/GFI.hs
View File

@@ -10,7 +10,7 @@ import GF.Command.Abstract
import GF.Command.Parse(readCommandLine,pCommand)
import GF.Data.ErrM
import GF.Data.Operations (chunks,err)
import GF.Grammar hiding (Ident)
import GF.Grammar hiding (Ident,isPrefixOf)
import GF.Grammar.Analyse
import GF.Grammar.Parser (runP, pExp)
import GF.Grammar.Printer (ppGrammar, ppModule)