mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-05-02 07:42:50 -06:00
GF/src is now for 2.9, and the new sources are in src-3.0 - keep it this way until the release of GF 3
This commit is contained in:
aarne
162
src-3.0/GF/UseGrammar/Information.hs
Normal file
162
src-3.0/GF/UseGrammar/Information.hs
Normal file
@@ -0,0 +1,162 @@
|
||||
----------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : Information
|
||||
-- Maintainer : AR
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date: 2005/10/05 20:02:20 $
|
||||
-- > CVS $Author: aarne $
|
||||
-- > CVS $Revision: 1.7 $
|
||||
--
|
||||
-- information on module, category, function, operation, parameter,...
|
||||
-- AR 16\/9\/2003.
|
||||
-- uses source grammar
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module GF.UseGrammar.Information (
|
||||
showInformation,
|
||||
missingLinCanonGrammar
|
||||
) where
|
||||
|
||||
import GF.Grammar.Grammar
|
||||
import GF.Infra.Ident
|
||||
import GF.Infra.Modules
|
||||
import GF.Infra.Option
|
||||
import GF.CF.CF
|
||||
import GF.CF.PPrCF
|
||||
import GF.Compile.ShellState
|
||||
import GF.Grammar.PrGrammar
|
||||
import GF.Grammar.Lookup
|
||||
import GF.Grammar.Macros (zIdent)
|
||||
import qualified GF.Canon.GFC as GFC
|
||||
import qualified GF.Canon.AbsGFC as AbsGFC
|
||||
|
||||
import GF.Data.Operations
|
||||
import GF.Infra.UseIO
|
||||
|
||||
-- information on module, category, function, operation, parameter,... AR 16/9/2003
|
||||
-- uses source grammar
|
||||
|
||||
-- | the top level function
|
||||
showInformation :: Options -> ShellState -> Ident -> IOE ()
|
||||
showInformation opts st c = do
|
||||
is <- ioeErr $ getInformation opts st c
|
||||
if null is
|
||||
then putStrLnE "Identifier not in scope"
|
||||
else mapM_ (putStrLnE . prInformationM c) is
|
||||
where
|
||||
prInformationM c (i,m) = prInformation opts c i ++ "file:" +++ m ++ "\n"
|
||||
|
||||
-- | the data type of different kinds of information
|
||||
data Information =
|
||||
IModAbs SourceAbs
|
||||
| IModRes SourceRes
|
||||
| IModCnc SourceCnc
|
||||
| IModule SourceAbs -- ^ to be deprecated
|
||||
| ICatAbs Ident Context [Ident]
|
||||
| ICatCnc Ident Type [CFRule] Term
|
||||
| IFunAbs Ident Type (Maybe Term)
|
||||
| IFunCnc Ident Type [CFRule] Term
|
||||
| IOper Ident Type Term
|
||||
| IParam Ident [Param] [Term]
|
||||
| IValue Ident Type
|
||||
|
||||
type CatId = AbsGFC.CIdent
|
||||
type FunId = AbsGFC.CIdent
|
||||
|
||||
prInformation :: Options -> Ident -> Information -> String
|
||||
prInformation opts c i = unlines $ prt c : case i of
|
||||
IModule m -> [
|
||||
"module of type" +++ show (mtype m),
|
||||
"extends" +++ show (extends m),
|
||||
"opens" +++ show (opens m),
|
||||
"defines" +++ unwords (map prt (ownConstants (jments m)))
|
||||
]
|
||||
ICatAbs m co _ -> [
|
||||
"category in abstract module" +++ prt m,
|
||||
if null co then "not a dependent type"
|
||||
else "dependent type with context" +++ prContext co
|
||||
]
|
||||
ICatCnc m ty cfs tr -> [
|
||||
"category in concrete module" +++ prt m,
|
||||
"linearization type" +++ prt ty
|
||||
]
|
||||
IFunAbs m ty _ -> [
|
||||
"function in abstract module" +++ prt m,
|
||||
"type" +++ prt ty
|
||||
]
|
||||
IFunCnc m ty cfs tr -> [
|
||||
"function in concrete module" +++ prt m,
|
||||
"linearization" +++ prt tr
|
||||
--- "linearization type" +++ prt ty
|
||||
]
|
||||
IOper m ty tr -> [
|
||||
"operation in resource module" +++ prt m,
|
||||
"type" +++ prt ty,
|
||||
"definition" +++ prt tr
|
||||
]
|
||||
IParam m ty ts -> [
|
||||
"parameter type in resource module" +++ prt m,
|
||||
"constructors" +++ unwords (map prParam ty),
|
||||
"values" +++ unwords (map prt ts)
|
||||
]
|
||||
IValue m ty -> [
|
||||
"parameter constructor in resource module" +++ prt m,
|
||||
"type" +++ show ty
|
||||
]
|
||||
|
||||
-- | also finds out if an identifier is defined in many places
|
||||
getInformation :: Options -> ShellState -> Ident -> Err [(Information,FilePath)]
|
||||
getInformation opts st c = allChecks $ [
|
||||
do
|
||||
m <- lookupModule src c
|
||||
case m of
|
||||
ModMod mo -> returnm c $ IModule mo
|
||||
_ -> prtBad "not a source module" c
|
||||
] ++ map lookInSrc ss ++ map lookInCan cs
|
||||
where
|
||||
lookInSrc (i,m) = do
|
||||
j <- lookupInfo m c
|
||||
case j of
|
||||
AbsCat (Yes co) _ -> returnm i $ ICatAbs i co [] ---
|
||||
AbsFun (Yes ty) _ -> returnm i $ IFunAbs i ty Nothing ---
|
||||
CncCat (Yes ty) _ _ -> do
|
||||
---- let cat = ident2CFCat i c
|
||||
---- rs <- concat [rs | (c,rs) <- cf, ]
|
||||
returnm i $ ICatCnc i ty [] ty ---
|
||||
CncFun _ (Yes tr) _ -> do
|
||||
rs <- return []
|
||||
returnm i $ IFunCnc i tr rs tr ---
|
||||
ResOper (Yes ty) (Yes tr) -> returnm i $ IOper i ty tr
|
||||
ResParam (Yes (ps,_)) -> do
|
||||
ts <- allParamValues src (QC i c)
|
||||
returnm i $ IParam i ps ts
|
||||
ResValue (Yes (ty,_)) -> returnm i $ IValue i ty ---
|
||||
|
||||
_ -> prtBad "nothing available for" i
|
||||
lookInCan (i,m) = do
|
||||
Bad "nothing available yet in canonical"
|
||||
|
||||
returnm m i = return (i, pathOfModule st m)
|
||||
|
||||
src = srcModules st
|
||||
can = canModules st
|
||||
ss = [(i,m) | (i,ModMod m) <- modules src]
|
||||
cs = [(i,m) | (i,ModMod m) <- modules can]
|
||||
cf = concatMap ruleGroupsOfCF $ map snd $ cfs st
|
||||
|
||||
ownConstants :: BinTree Ident Info -> [Ident]
|
||||
ownConstants = map fst . filter isOwn . tree2list where
|
||||
isOwn (c,i) = case i of
|
||||
AnyInd _ _ -> False
|
||||
_ -> True
|
||||
|
||||
missingLinCanonGrammar :: GFC.CanonGrammar -> String
|
||||
missingLinCanonGrammar cgr =
|
||||
unlines $ concat [prt_ c : missing js | (c,js) <- concretes] where
|
||||
missing js = map ((" " ++) . prt_) $ filter (not . flip isInBinTree js) abstract
|
||||
abstract = err (const []) (map fst . tree2list . jments) $ lookupModMod cgr absId
|
||||
absId = maybe (zIdent "") id $ greatestAbstract cgr
|
||||
concretes = [(cnc,jments mo) |
|
||||
cnc <- allConcretes cgr absId, Ok mo <- [lookupModMod cgr cnc]]
|
||||
Reference in New Issue
Block a user