1
0
forked from GitHub/gf-core

the command show_operations to inspect opers in scope

This commit is contained in:
aarne
2011-02-28 13:31:04 +00:00
parent 66f95c2cb7
commit 0dfbc9b730
4 changed files with 98 additions and 12 deletions

View File

@@ -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",

View File

@@ -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

View File

@@ -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))

View File

@@ -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"