summaryrefslogtreecommitdiff
path: root/src/compiler/GF/Compile
diff options
context:
space:
mode:
Diffstat (limited to 'src/compiler/GF/Compile')
-rw-r--r--src/compiler/GF/Compile/Compute/AppPredefined.hs12
-rw-r--r--src/compiler/GF/Compile/Compute/ConcreteLazy.hs3
-rw-r--r--src/compiler/GF/Compile/Compute/ConcreteNew.hs5
-rw-r--r--src/compiler/GF/Compile/Compute/ConcreteNew1.hs3
-rw-r--r--src/compiler/GF/Compile/GeneratePMCFG.hs7
-rw-r--r--src/compiler/GF/Compile/Optimize.hs3
-rw-r--r--src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs7
-rw-r--r--src/compiler/GF/Compile/TypeCheck/TC.hs2
8 files changed, 15 insertions, 27 deletions
diff --git a/src/compiler/GF/Compile/Compute/AppPredefined.hs b/src/compiler/GF/Compile/Compute/AppPredefined.hs
index d4b6dfb41..869052e0a 100644
--- a/src/compiler/GF/Compile/Compute/AppPredefined.hs
+++ b/src/compiler/GF/Compile/Compute/AppPredefined.hs
@@ -16,14 +16,13 @@ module GF.Compile.Compute.AppPredefined (
isInPredefined, typPredefined, arrityPredefined, predefModInfo, appPredefined
) where
-import GF.Infra.Ident
+import GF.Infra.Ident(identS)
import GF.Infra.Option
import GF.Data.Operations
import GF.Grammar
import GF.Grammar.Predef
import qualified Data.Map as Map
-import qualified Data.ByteString.Char8 as BS
import Text.PrettyPrint
import Data.Char (isUpper,toUpper,toLower)
@@ -90,11 +89,8 @@ primitives = Map.fromList
fun from to = oper (mkFunType from to)
oper ty = ResOper (Just (noLoc ty)) Nothing
- varL :: Ident
- varL = identC (BS.pack "L")
-
- varP :: Ident
- varP = identC (BS.pack "P")
+ varL = identS "L"
+ varP = identS "P"
appPredefined :: Term -> Err (Term,Bool)
appPredefined t = case t of
@@ -127,7 +123,7 @@ appPredefined t = case t of
(EInt i, EInt j) | f == cLessInt -> retb $ if i<j then predefTrue else predefFalse
(EInt i, EInt j) | f == cPlus -> retb $ EInt $ i+j
(_, t) | f == cShow && notVar t -> retb $ foldrC $ map K $ words $ render (ppTerm Unqualified 0 t)
- (_, K s) | f == cRead -> retb $ Cn (identC (BS.pack s)) --- because of K, only works for atomic tags
+ (_, K s) | f == cRead -> retb $ Cn (identS s) --- because of K, only works for atomic tags
(_, t) | f == cToStr -> trm2str t >>= retb
_ -> retb t ---- prtBad "cannot compute predefined" t
diff --git a/src/compiler/GF/Compile/Compute/ConcreteLazy.hs b/src/compiler/GF/Compile/Compute/ConcreteLazy.hs
index fce118fec..0e3a4fb45 100644
--- a/src/compiler/GF/Compile/Compute/ConcreteLazy.hs
+++ b/src/compiler/GF/Compile/Compute/ConcreteLazy.hs
@@ -508,8 +508,7 @@ computeTermOpt gr = comput True where
-- | argument variables cannot be glued
checkNoArgVars :: Term -> Comp Term
checkNoArgVars t = case t of
- Vr (IA _ _) -> fail $ glueErrorMsg $ ppTerm Unqualified 0 t
- Vr (IAV _ _ _) -> fail $ glueErrorMsg $ ppTerm Unqualified 0 t
+ Vr x | isArgIdent x -> fail $ glueErrorMsg $ ppTerm Unqualified 0 t
_ -> composOp checkNoArgVars t
glueErrorMsg s =
diff --git a/src/compiler/GF/Compile/Compute/ConcreteNew.hs b/src/compiler/GF/Compile/Compute/ConcreteNew.hs
index 3a05d62fb..3e87ea43a 100644
--- a/src/compiler/GF/Compile/Compute/ConcreteNew.hs
+++ b/src/compiler/GF/Compile/Compute/ConcreteNew.hs
@@ -19,7 +19,6 @@ import Control.Monad(ap,liftM,liftM2,mplus,unless)
import Data.List (findIndex,intersect,isInfixOf,nub,elemIndex,(\\))
import Data.Char (isUpper,toUpper,toLower)
import Text.PrettyPrint
-import qualified Data.ByteString.Char8 as BS
import qualified Data.Map as Map
--import Debug.Trace(trace)
@@ -80,7 +79,7 @@ resource env (m,c) =
resourceValues :: SourceGrammar -> GlobalEnv
resourceValues gr = env
where
- env = GE gr rvs (L NoLoc IW)
+ env = GE gr rvs (L NoLoc identW)
rvs = Map.mapWithKey moduleResources (moduleMap gr)
moduleResources m = Map.mapWithKey (moduleResource m) . jments
moduleResource m c _info = do L l t <- lookupResDefLoc gr (m,c)
@@ -115,7 +114,7 @@ value env t0 =
Vr x -> var env x
Q x@(m,f)
| m == cPredef -> if f==cErrorType -- to be removed
- then let p = identC (BS.pack "P")
+ then let p = identS "P"
in const # value0 env (mkProd [(Implicit,p,typeType)] (Vr p) [])
else const . flip VApp [] # predef f
| otherwise -> const # resource env x --valueResDef (fst env) x
diff --git a/src/compiler/GF/Compile/Compute/ConcreteNew1.hs b/src/compiler/GF/Compile/Compute/ConcreteNew1.hs
index 59c9ef6b4..354f8249e 100644
--- a/src/compiler/GF/Compile/Compute/ConcreteNew1.hs
+++ b/src/compiler/GF/Compile/Compute/ConcreteNew1.hs
@@ -9,7 +9,6 @@ import GF.Grammar.Predef
import GF.Data.Operations
import Data.List (intersect)
import Text.PrettyPrint
-import qualified Data.ByteString.Char8 as BS
normalForm :: SourceGrammar -> Term -> Term
normalForm gr t = value2term gr [] (eval gr [] t)
@@ -44,7 +43,7 @@ eval gr env (Vr x) = case lookup x env of
Nothing -> error ("Unknown variable "++showIdent x)
eval gr env (Q x)
| x == (cPredef,cErrorType) -- to be removed
- = let varP = identC (BS.pack "P")
+ = let varP = identS "P"
in eval gr [] (mkProd [(Implicit,varP,typeType)] (Vr varP) [])
| fst x == cPredef = VApp x []
| otherwise = case lookupResDef gr x of
diff --git a/src/compiler/GF/Compile/GeneratePMCFG.hs b/src/compiler/GF/Compile/GeneratePMCFG.hs
index 47b9c3cb5..82f8ba61a 100644
--- a/src/compiler/GF/Compile/GeneratePMCFG.hs
+++ b/src/compiler/GF/Compile/GeneratePMCFG.hs
@@ -32,7 +32,6 @@ import qualified Data.Set as Set
import qualified Data.List as List
import qualified Data.IntMap as IntMap
import qualified Data.IntSet as IntSet
-import qualified Data.ByteString.Char8 as BS
import Text.PrettyPrint hiding (Str)
import Data.Array.IArray
import Data.Array.Unboxed
@@ -553,10 +552,8 @@ evalTerm path (EInt n) = return (EInt n)
evalTerm path t = ppbug (text "evalTerm" <+> parens (ppU 0 t))
--evalTerm path t = ppbug (text "evalTerm" <+> sep [parens (text (show path)),parens (text (show t))])
-getVarIndex (IA _ i) = i
-getVarIndex (IAV _ _ i) = i
-getVarIndex (IC s) | isDigit (BS.last s) = (read . BS.unpack . snd . BS.spanEnd isDigit) s
-getVarIndex x = bug ("getVarIndex "++show x)
+getVarIndex x = maybe err id $ getArgIndex x
+ where err = bug ("getVarIndex "++show x)
----------------------------------------------------------------------
-- GrammarEnv
diff --git a/src/compiler/GF/Compile/Optimize.hs b/src/compiler/GF/Compile/Optimize.hs
index 11d30d051..9ee50251b 100644
--- a/src/compiler/GF/Compile/Optimize.hs
+++ b/src/compiler/GF/Compile/Optimize.hs
@@ -35,7 +35,6 @@ import Data.List
import qualified Data.Set as Set
import Text.PrettyPrint
import Debug.Trace
-import qualified Data.ByteString.Char8 as BS
-- | partial evaluation of concrete syntax. AR 6\/2001 -- 16\/5\/2003 -- 5\/2\/2005.
@@ -194,7 +193,7 @@ factor param c i t =
else V ty (map snd pvs0)
--- we hope this will be fresh and don't check... in GFC would be safe
- qvar = identC (BS.pack ("q_" ++ showIdent c ++ "__" ++ show i))
+ qvar = identS ("q_" ++ showIdent c ++ "__" ++ show i)
mkFun (patt, val) = replace (patt2term patt) (Vr qvar) val
mkCases t = [(PV qvar, t)]
diff --git a/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs b/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs
index e2473aae8..583d614d3 100644
--- a/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs
+++ b/src/compiler/GF/Compile/TypeCheck/ConcreteNew.hs
@@ -13,7 +13,6 @@ import GF.Data.Operations
import Text.PrettyPrint
import Data.List (nub, (\\), tails)
import qualified Data.IntMap as IntMap
-import qualified Data.ByteString.Char8 as BS
import GF.Grammar.Parser
import System.IO
@@ -438,8 +437,8 @@ quantify gr scope t tvs ty0 = do
bndrs _ = []
allBinders :: [Ident] -- a,b,..z, a1, b1,... z1, a2, b2,...
-allBinders = [ identC (BS.pack [x]) | x <- ['a'..'z'] ] ++
- [ identC (BS.pack (x : show i)) | i <- [1 :: Integer ..], x <- ['a'..'z']]
+allBinders = [ identS [x] | x <- ['a'..'z'] ] ++
+ [ identS (x : show i) | i <- [1 :: Integer ..], x <- ['a'..'z']]
-----------------------------------------------------------------------
@@ -502,7 +501,7 @@ setMeta i mv = TcM (\ms msgs -> TcOk () (IntMap.insert i mv ms) msgs)
newVar :: Scope -> Ident
newVar scope = head [x | i <- [1..],
- let x = identC (BS.pack ('v':show i)),
+ let x = identS ('v':show i),
isFree scope x]
where
isFree [] x = True
diff --git a/src/compiler/GF/Compile/TypeCheck/TC.hs b/src/compiler/GF/Compile/TypeCheck/TC.hs
index a56a8c832..5a7fa9479 100644
--- a/src/compiler/GF/Compile/TypeCheck/TC.hs
+++ b/src/compiler/GF/Compile/TypeCheck/TC.hs
@@ -57,7 +57,7 @@ lookupConst :: Theory -> QIdent -> Err Val
lookupConst th f = th f
lookupVar :: Env -> Ident -> Err Val
-lookupVar g x = maybe (Bad (render (text "unknown variable" <+> ppIdent x))) return $ lookup x ((IW,uVal):g)
+lookupVar g x = maybe (Bad (render (text "unknown variable" <+> ppIdent x))) return $ lookup x ((identW,uVal):g)
-- wild card IW: no error produced, ?0 instead.
type TCEnv = (Int,Env,Env)
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 05:58:19 +0000