module GF.Compile.Rename (
renameSourceTerm,
renameModule
) where
import GF.Infra.Ident
import GF.Infra.CheckM
import GF.Grammar.Grammar
import GF.Grammar.Values
import GF.Grammar.Predef
import GF.Grammar.Lookup
import GF.Grammar.Macros
import GF.Grammar.Printer
import GF.Data.Operations
import Control.Monad
import Data.List (nub,(\\))
import qualified Data.List as L
import qualified Data.Map as Map
import Data.Maybe(mapMaybe)
import GF.Text.Pretty
-- | this gives top-level access to renaming term input in the cc command
renameSourceTerm :: Grammar -> ModuleName -> Term -> Check Term
renameSourceTerm g m t = do
mi <- lookupModule g m
status <- buildStatus "" g (m,mi)
renameTerm status [] t
renameModule :: FilePath -> Grammar -> Module -> Check Module
renameModule cwd gr mo@(m,mi) = do
status <- buildStatus cwd gr mo
js <- checkMapRecover (renameInfo cwd status mo) (jments mi)
return (m, mi{jments = js})
type Status = (StatusMap, [(OpenSpec, StatusMap)])
type StatusMap = Map.Map Ident StatusInfo
type StatusInfo = Ident -> Term
-- Delays errors, allowing many errors to be detected and reported
renameIdentTerm env = accumulateError (renameIdentTerm' env)
-- Fails immediately on error, makes it possible to try other possibilities
renameIdentTerm' :: Status -> Term -> Check Term
renameIdentTerm' env@(act,imps) t0 =
case t0 of
Vr c -> ident predefAbs c
Cn c -> ident (\_ s -> checkError s) c
Q (m',c) | m' == cPredef {- && isInPredefined c -} -> return t0
Q (m',c) -> do
m <- lookupErr m' qualifs
f <- lookupIdent c m
return $ f c
QC (m',c) | m' == cPredef {- && isInPredefined c -} -> return t0
QC (m',c) -> do
m <- lookupErr m' qualifs
f <- lookupIdent c m
return $ f c
_ -> return t0
where
opens = [st | (OSimple _,st) <- imps]
qualifs = [(m, st) | (OQualif m _, st) <- imps] ++
[(m, st) | (OQualif _ m, st) <- imps] ++
[(m, st) | (OSimple m, st) <- imps] -- qualif is always possible
-- this facility is mainly for BWC with GF1: you need not import PredefAbs
predefAbs c s
| isPredefCat c = return (Q (cPredefAbs,c))
| otherwise = checkError s
ident alt c =
case Map.lookup c act of
Just f -> return (f c)
_ -> case mapMaybe (Map.lookup c) opens of
[f] -> return (f c)
[] -> alt c ("constant not found:" <+> c $$
"given" <+> fsep (punctuate ',' (map fst qualifs)))
fs -> case nub [f c | f <- fs] of
[tr] -> return tr
ts@(t:_) -> do checkWarn ("atomic term" <+> ppTerm Qualified 0 t0 $$
"conflict" <+> hsep (punctuate ',' (map (ppTerm Qualified 0) ts)) $$
"given" <+> fsep (punctuate ',' (map fst qualifs)))
return (bestTerm ts) -- Heuristic for resource grammar. Returns t for all others.
where
-- Hotfix for https://github.com/GrammaticalFramework/gf-core/issues/56
-- Real bug is probably somewhere deeper in recognising excluded functions. /IL 2020-06-06
notFromCommonModule :: Term -> Bool
notFromCommonModule term =
let t = render $ ppTerm Qualified 0 term :: String
in not $ any (\moduleName -> moduleName `L.isPrefixOf` t)
["CommonX", "ConstructX", "ExtendFunctor"
,"MarkHTMLX", "ParamX", "TenseX", "TextX"]
-- If one of the terms comes from the common modules,
-- we choose the other one, because that's defined in the grammar.
bestTerm :: [Term] -> Term
bestTerm [] = error "constant not found" -- not reached: bestTerm is only called for case ts@(t:_)
bestTerm ts@(t:_) =
let notCommon = [t | t <- ts, notFromCommonModule t]
in case notCommon of
[] -> t -- All terms are from common modules, return first of original list
(u:_) -> u --