forked from GitHub/gf-core
the command show_operations to inspect opers in scope
This commit is contained in:
@@ -781,6 +781,29 @@ allCommands env@(pgf, mos) = Map.fromList [
|
|||||||
"gt | l | sp -command=\"grep \\\"who\\\"\" | sp -command=\"wc\""
|
"gt | l | sp -command=\"grep \\\"who\\\"\" | sp -command=\"wc\""
|
||||||
]
|
]
|
||||||
}),
|
}),
|
||||||
|
|
||||||
|
("so", emptyCommandInfo {
|
||||||
|
longname = "show_operations",
|
||||||
|
syntax = "so (-grep=STRING)* TYPE?",
|
||||||
|
synopsis = "show all operations in scope, possibly restricted to a value type",
|
||||||
|
explanation = unlines [
|
||||||
|
"Show the names and type signatures of all operations available in the current resource.",
|
||||||
|
"This command requires a source grammar to be in scope, imported with 'import -retain'.",
|
||||||
|
"The operations include the parameter constructors that are in scope.",
|
||||||
|
"The optional TYPE filters according to the value type.",
|
||||||
|
"The grep STRINGs filter according to other substrings of the type signatures.",
|
||||||
|
"This command must be a line of its own, and thus cannot be a part",
|
||||||
|
"of a pipe."
|
||||||
|
],
|
||||||
|
flags = [
|
||||||
|
("grep","substring used for filtering (the command can have many of these)")
|
||||||
|
],
|
||||||
|
options = [
|
||||||
|
("raw","show the types in computed forms (instead of category names)")
|
||||||
|
],
|
||||||
|
needsTypeCheck = False
|
||||||
|
}),
|
||||||
|
|
||||||
("ut", emptyCommandInfo {
|
("ut", emptyCommandInfo {
|
||||||
longname = "unicode_table",
|
longname = "unicode_table",
|
||||||
synopsis = "show a transliteration table for a unicode character set",
|
synopsis = "show a transliteration table for a unicode character set",
|
||||||
|
|||||||
@@ -28,7 +28,8 @@ module GF.Grammar.Lookup (
|
|||||||
lookupAbsDef,
|
lookupAbsDef,
|
||||||
lookupLincat,
|
lookupLincat,
|
||||||
lookupFunType,
|
lookupFunType,
|
||||||
lookupCatContext
|
lookupCatContext,
|
||||||
|
allOpers, allOpersTo
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import GF.Data.Operations
|
import GF.Data.Operations
|
||||||
@@ -43,6 +44,7 @@ import GF.Grammar.Lockfield
|
|||||||
import Data.List (nub,sortBy)
|
import Data.List (nub,sortBy)
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Text.PrettyPrint
|
import Text.PrettyPrint
|
||||||
|
import qualified Data.Map as Map
|
||||||
|
|
||||||
-- whether lock fields are added in reuse
|
-- whether lock fields are added in reuse
|
||||||
lock c = lockRecType c -- return
|
lock c = lockRecType c -- return
|
||||||
@@ -189,3 +191,39 @@ lookupCatContext gr m c = do
|
|||||||
AbsCat (Just (L _ co)) -> return co
|
AbsCat (Just (L _ co)) -> return co
|
||||||
AnyInd _ n -> lookupCatContext gr n c
|
AnyInd _ n -> lookupCatContext gr n c
|
||||||
_ -> Bad (render (text "unknown category" <+> ppIdent c))
|
_ -> Bad (render (text "unknown category" <+> ppIdent c))
|
||||||
|
|
||||||
|
|
||||||
|
-- this gives all opers and param constructors, also overloaded opers and funs, and the types, and locations
|
||||||
|
-- notice that it only gives the modules that are reachable and the opers that are included
|
||||||
|
|
||||||
|
allOpers :: SourceGrammar -> [((Ident,Ident),Type,(Int,Int))]
|
||||||
|
allOpers gr =
|
||||||
|
[((mo,op),typ,loc) |
|
||||||
|
(mo,minc) <- reachable,
|
||||||
|
Ok minfo <- [lookupModule gr mo],
|
||||||
|
(op,info) <- Map.toList $ jments minfo,
|
||||||
|
isInherited minc op,
|
||||||
|
L loc typ <- typesIn info
|
||||||
|
]
|
||||||
|
where
|
||||||
|
typesIn info = case info of
|
||||||
|
AbsFun (Just ltyp) _ _ _ -> [ltyp]
|
||||||
|
ResOper (Just ltyp) _ -> [ltyp]
|
||||||
|
ResValue ltyp -> [ltyp]
|
||||||
|
ResOverload _ tytrs -> [ltyp | (ltyp,_) <- tytrs]
|
||||||
|
_ -> []
|
||||||
|
reachable = case greatestResource gr of
|
||||||
|
Just r -> allExtendSpecs gr r
|
||||||
|
_ -> []
|
||||||
|
|
||||||
|
--- not for dependent types
|
||||||
|
allOpersTo :: SourceGrammar -> Type -> [((Ident,Ident),Type,(Int,Int))]
|
||||||
|
allOpersTo gr ty = [op | op@(_,typ,_) <- allOpers gr, isProdTo ty typ] where
|
||||||
|
isProdTo t typ = eqProd typ t || case typ of
|
||||||
|
Prod _ _ a b -> isProdTo t b
|
||||||
|
_ -> False
|
||||||
|
eqProd f g = case (f,g) of
|
||||||
|
(Prod _ _ a1 b1, Prod _ _ a2 b2) -> eqProd a1 a2 && eqProd b1 b2
|
||||||
|
_ -> f == g
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -621,6 +621,7 @@ allDependencies ism b =
|
|||||||
opty _ = []
|
opty _ = []
|
||||||
pts i = case i of
|
pts i = case i of
|
||||||
ResOper pty pt -> [pty,pt]
|
ResOper pty pt -> [pty,pt]
|
||||||
|
--- ResOverload _ tyts -> concat [[Just ty, Just tr] | (ty,tr) <- tyts]
|
||||||
ResParam (Just ps) _ -> [Just (L loc t) | L loc (_,cont) <- ps, (_,_,t) <- cont]
|
ResParam (Just ps) _ -> [Just (L loc t) | L loc (_,cont) <- ps, (_,_,t) <- cont]
|
||||||
CncCat pty _ _ -> [pty]
|
CncCat pty _ _ -> [pty]
|
||||||
CncFun _ pt _ -> [pt] ---- (Maybe (Ident,(Context,Type))
|
CncFun _ pt _ -> [pt] ---- (Maybe (Ident,(Context,Type))
|
||||||
|
|||||||
@@ -7,13 +7,14 @@ import GF.Command.Commands
|
|||||||
import GF.Command.Abstract
|
import GF.Command.Abstract
|
||||||
import GF.Command.Parse
|
import GF.Command.Parse
|
||||||
import GF.Data.ErrM
|
import GF.Data.ErrM
|
||||||
import GF.Data.Operations (chunks)
|
import GF.Data.Operations (chunks,err)
|
||||||
import GF.Grammar hiding (Ident)
|
import GF.Grammar hiding (Ident)
|
||||||
import GF.Grammar.Parser (runP, pExp)
|
import GF.Grammar.Parser (runP, pExp)
|
||||||
import GF.Grammar.ShowTerm
|
import GF.Grammar.ShowTerm
|
||||||
|
import GF.Grammar.Lookup (allOpers,allOpersTo)
|
||||||
import GF.Compile.Rename
|
import GF.Compile.Rename
|
||||||
import GF.Compile.Compute.Concrete (computeConcrete,checkPredefError)
|
import GF.Compile.Compute.Concrete (computeConcrete,checkPredefError)
|
||||||
import GF.Compile.TypeCheck.Concrete (inferLType)
|
import GF.Compile.TypeCheck.Concrete (inferLType,ppType)
|
||||||
import GF.Infra.Dependencies
|
import GF.Infra.Dependencies
|
||||||
import GF.Infra.CheckM
|
import GF.Infra.CheckM
|
||||||
import GF.Infra.UseIO
|
import GF.Infra.UseIO
|
||||||
@@ -30,7 +31,7 @@ import PGF.Macros
|
|||||||
|
|
||||||
import Data.Char
|
import Data.Char
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.List(isPrefixOf)
|
import Data.List(isPrefixOf,isInfixOf,partition)
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
import qualified Data.ByteString.Char8 as BS
|
import qualified Data.ByteString.Char8 as BS
|
||||||
import qualified Text.ParserCombinators.ReadP as RP
|
import qualified Text.ParserCombinators.ReadP as RP
|
||||||
@@ -41,6 +42,7 @@ import System.Directory
|
|||||||
import Control.Exception
|
import Control.Exception
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Data.Version
|
import Data.Version
|
||||||
|
import Text.PrettyPrint (render)
|
||||||
import GF.System.Signal
|
import GF.System.Signal
|
||||||
--import System.IO.Error (try)
|
--import System.IO.Error (try)
|
||||||
#ifdef mingw32_HOST_OS
|
#ifdef mingw32_HOST_OS
|
||||||
@@ -120,19 +122,34 @@ loop opts gfenv0 = do
|
|||||||
|
|
||||||
(style,q,s) = pOpts TermPrintDefault Qualified (tail (words s0))
|
(style,q,s) = pOpts TermPrintDefault Qualified (tail (words s0))
|
||||||
|
|
||||||
checkComputeTerm gr (L _ t) = do
|
|
||||||
mo <- maybe (Bad "no source grammar in scope") return $ greatestResource gr
|
|
||||||
((t,_),_) <- runCheck $ do t <- renameSourceTerm gr mo t
|
|
||||||
inferLType gr [] t
|
|
||||||
t1 <- computeConcrete sgr t
|
|
||||||
checkPredefError sgr t1
|
|
||||||
|
|
||||||
case runP pExp (encodeUnicode utf8 s) of
|
case runP pExp (encodeUnicode utf8 s) of
|
||||||
Left (_,msg) -> putStrLn msg
|
Left (_,msg) -> putStrLn msg
|
||||||
Right t -> case checkComputeTerm sgr (codeTerm (decodeUnicode utf8 . BS.pack) (L (0,0) t)) of
|
Right t -> case checkComputeTerm sgr (unLoc (codeTerm (decodeUnicode utf8 . BS.pack) (L (0,0) t))) of
|
||||||
Ok x -> putStrLn $ showTerm sgr style q x
|
Ok x -> putStrLn $ showTerm sgr style q x
|
||||||
Bad s -> putStrLn $ s
|
Bad s -> putStrLn $ s
|
||||||
loopNewCPU gfenv
|
loopNewCPU gfenv
|
||||||
|
|
||||||
|
"so":ws -> case greatestResource sgr of
|
||||||
|
Nothing -> putStrLn "no source grammar in scope" >> loopNewCPU gfenv
|
||||||
|
Just mo -> do
|
||||||
|
let (os,ts) = partition (isPrefixOf "-") ws
|
||||||
|
let greps = [drop 6 o | o <- os, take 6 o == "-grep="]
|
||||||
|
let isRaw = elem "-raw" os
|
||||||
|
ops <- case ts of
|
||||||
|
_:_ -> do
|
||||||
|
let Right t = runP pExp (encodeUnicode utf8 (unwords ts))
|
||||||
|
ty <- err error return $ checkComputeTerm sgr t
|
||||||
|
return $ allOpersTo sgr ty
|
||||||
|
_ -> return $ allOpers sgr
|
||||||
|
let sigs = [(op,ty) | ((mo,op),ty,pos) <- ops]
|
||||||
|
let printer = if isRaw
|
||||||
|
then showTerm sgr TermPrintDefault Qualified
|
||||||
|
else (render . GF.Compile.TypeCheck.Concrete.ppType)
|
||||||
|
let printed = [unwords [showIdent op, ":", printer ty] | (op,ty) <- sigs]
|
||||||
|
mapM_ putStrLn [l | l <- printed, all (flip isInfixOf l) greps]
|
||||||
|
loopNewCPU gfenv
|
||||||
|
|
||||||
|
|
||||||
"dg":ws -> do
|
"dg":ws -> do
|
||||||
let stop = case ws of
|
let stop = case ws of
|
||||||
('-':'o':'n':'l':'y':'=':fs):_ -> Just $ chunks ',' fs
|
('-':'o':'n':'l':'y':'=':fs):_ -> Just $ chunks ',' fs
|
||||||
@@ -206,6 +223,13 @@ loop opts gfenv0 = do
|
|||||||
gfenv' <- either (\e -> (print e >> return gfenv)) return r
|
gfenv' <- either (\e -> (print e >> return gfenv)) return r
|
||||||
loop opts gfenv'
|
loop opts gfenv'
|
||||||
|
|
||||||
|
checkComputeTerm sgr t = do
|
||||||
|
mo <- maybe (Bad "no source grammar in scope") return $ greatestResource sgr
|
||||||
|
((t,_),_) <- runCheck $ do t <- renameSourceTerm sgr mo t
|
||||||
|
inferLType sgr [] t
|
||||||
|
t1 <- computeConcrete sgr t
|
||||||
|
checkPredefError sgr t1
|
||||||
|
|
||||||
fetchCommand :: GFEnv -> IO String
|
fetchCommand :: GFEnv -> IO String
|
||||||
fetchCommand gfenv = do
|
fetchCommand gfenv = do
|
||||||
path <- getAppUserDataDirectory "gf_history"
|
path <- getAppUserDataDirectory "gf_history"
|
||||||
|
|||||||
Reference in New Issue
Block a user