summaryrefslogtreecommitdiff
path: root/src/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'src/compiler')
-rw-r--r--src/compiler/GF/Command/Importing.hs5
-rw-r--r--src/compiler/GF/Compile.hs3
-rw-r--r--src/compiler/GF/Compile/GrammarToPGF.hs4
-rw-r--r--src/compiler/GF/Compile/SubExOpt.hs9
-rw-r--r--src/compiler/GF/Grammar/Binary.hs5
-rw-r--r--src/compiler/GF/Grammar/Grammar.hs14
-rw-r--r--src/compiler/GF/Grammar/Lexer.hs10
-rw-r--r--src/compiler/GF/Grammar/Lockfield.hs8
-rw-r--r--src/compiler/GF/Grammar/MMacros.hs11
-rw-r--r--src/compiler/GF/Grammar/Parser.y4
-rw-r--r--src/compiler/GF/Grammar/lexer/Lexer.x4
-rw-r--r--src/compiler/GF/Infra/Dependencies.hs2
-rw-r--r--src/compiler/GF/Infra/Ident.hs57
-rw-r--r--src/compiler/GFI.hs2
14 files changed, 74 insertions, 64 deletions
diff --git a/src/compiler/GF/Command/Importing.hs b/src/compiler/GF/Command/Importing.hs
index d8b7f0e0c..ce06156e4 100644
--- a/src/compiler/GF/Command/Importing.hs
+++ b/src/compiler/GF/Command/Importing.hs
@@ -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 ----
diff --git a/src/compiler/GF/Compile.hs b/src/compiler/GF/Compile.hs
index 67fd750a2..e572920df 100644
--- a/src/compiler/GF/Compile.hs
+++ b/src/compiler/GF/Compile.hs
@@ -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
diff --git a/src/compiler/GF/Compile/GrammarToPGF.hs b/src/compiler/GF/Compile/GrammarToPGF.hs
index 5ec7f9774..b1a2c5d33 100644
--- a/src/compiler/GF/Compile/GrammarToPGF.hs
+++ b/src/compiler/GF/Compile/GrammarToPGF.hs
@@ -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
diff --git a/src/compiler/GF/Compile/SubExOpt.hs b/src/compiler/GF/Compile/SubExOpt.hs
index bfa2a1334..4c056f479 100644
--- a/src/compiler/GF/Compile/SubExOpt.hs
+++ b/src/compiler/GF/Compile/SubExOpt.hs
@@ -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''")
diff --git a/src/compiler/GF/Grammar/Binary.hs b/src/compiler/GF/Grammar/Binary.hs
index ae0c72809..fab63a7ba 100644
--- a/src/compiler/GF/Grammar/Binary.hs
+++ b/src/compiler/GF/Grammar/Binary.hs
@@ -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)
diff --git a/src/compiler/GF/Grammar/Grammar.hs b/src/compiler/GF/Grammar/Grammar.hs
index c59cd809e..2efec220b 100644
--- a/src/compiler/GF/Grammar/Grammar.hs
+++ b/src/compiler/GF/Grammar/Grammar.hs
@@ -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)
diff --git a/src/compiler/GF/Grammar/Lexer.hs b/src/compiler/GF/Grammar/Lexer.hs
index 3ab9eda61..a9fef2cc4 100644
--- a/src/compiler/GF/Grammar/Lexer.hs
+++ b/src/compiler/GF/Grammar/Lexer.hs
@@ -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>" #-}
diff --git a/src/compiler/GF/Grammar/Lockfield.hs b/src/compiler/GF/Grammar/Lockfield.hs
index 8b0798527..5c2f5d0f0 100644
--- a/src/compiler/GF/Grammar/Lockfield.hs
+++ b/src/compiler/GF/Grammar/Lockfield.hs
@@ -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_"
diff --git a/src/compiler/GF/Grammar/MMacros.hs b/src/compiler/GF/Grammar/MMacros.hs
index f1d2f172a..1b9060003 100644
--- a/src/compiler/GF/Grammar/MMacros.hs
+++ b/src/compiler/GF/Grammar/MMacros.hs
@@ -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
diff --git a/src/compiler/GF/Grammar/Parser.y b/src/compiler/GF/Grammar/Parser.y
index a84db6ffd..e5a7f359c 100644
--- a/src/compiler/GF/Grammar/Parser.y
+++ b/src/compiler/GF/Grammar/Parser.y
@@ -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 }
diff --git a/src/compiler/GF/Grammar/lexer/Lexer.x b/src/compiler/GF/Grammar/lexer/Lexer.x
index ca796808b..4050f4854 100644
--- a/src/compiler/GF/Grammar/lexer/Lexer.x
+++ b/src/compiler/GF/Grammar/lexer/Lexer.x
@@ -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) }
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'
diff --git a/src/compiler/GFI.hs b/src/compiler/GFI.hs
index bd67f29bc..7c53ed8d8 100644
--- a/src/compiler/GFI.hs
+++ b/src/compiler/GFI.hs
@@ -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)
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 05:58:10 +0000