the command show_operations to inspect opers in scope

4 files changed, 98 insertions, 12 deletions

diff --git a/src/compiler/GF/Command/Commands.hs b/src/compiler/GF/Command/Commands.hs
index f7a34ee27..0161818f8 100644
--- a/src/compiler/GF/Command/Commands.hs
+++ b/src/compiler/GF/Command/Commands.hs
@@ -781,6 +781,29 @@ allCommands env@(pgf, mos) = Map.fromList [
        "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 {
      longname = "unicode_table",
      synopsis = "show a transliteration table for a unicode character set",
diff --git a/src/compiler/GF/Grammar/Lookup.hs b/src/compiler/GF/Grammar/Lookup.hs
index 80dabef1b..b5959cf03 100644
--- a/src/compiler/GF/Grammar/Lookup.hs
+++ b/src/compiler/GF/Grammar/Lookup.hs
@@ -28,7 +28,8 @@ module GF.Grammar.Lookup (
            lookupAbsDef, 
            lookupLincat, 
            lookupFunType,
-           lookupCatContext
+           lookupCatContext,
+           allOpers, allOpersTo
 	      ) where
 
 import GF.Data.Operations
@@ -43,6 +44,7 @@ import GF.Grammar.Lockfield
 import Data.List (nub,sortBy)
 import Control.Monad
 import Text.PrettyPrint
+import qualified Data.Map as Map
 
 -- whether lock fields are added in reuse
 lock c = lockRecType c -- return
@@ -189,3 +191,39 @@ lookupCatContext gr m c = do
     AbsCat (Just (L _ co)) -> return co
     AnyInd _ n             -> lookupCatContext gr n 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
+
+ 
diff --git a/src/compiler/GF/Grammar/Macros.hs b/src/compiler/GF/Grammar/Macros.hs
index b40041e83..fb9979c31 100644
--- a/src/compiler/GF/Grammar/Macros.hs
+++ b/src/compiler/GF/Grammar/Macros.hs
@@ -621,6 +621,7 @@ allDependencies ism b =
     opty _ = []
     pts i = case i of
       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]
       CncCat pty _ _ -> [pty]
       CncFun _   pt _ -> [pt]  ---- (Maybe (Ident,(Context,Type))
diff --git a/src/compiler/GFI.hs b/src/compiler/GFI.hs
index 665d843cb..a7ae2d07c 100644
--- a/src/compiler/GFI.hs
+++ b/src/compiler/GFI.hs
@@ -7,13 +7,14 @@ import GF.Command.Commands
 import GF.Command.Abstract
 import GF.Command.Parse
 import GF.Data.ErrM
-import GF.Data.Operations (chunks)
+import GF.Data.Operations (chunks,err)
 import GF.Grammar hiding (Ident)
 import GF.Grammar.Parser (runP, pExp)
 import GF.Grammar.ShowTerm
+import GF.Grammar.Lookup (allOpers,allOpersTo)
 import GF.Compile.Rename
 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.CheckM
 import GF.Infra.UseIO
@@ -30,7 +31,7 @@ import PGF.Macros
 
 import Data.Char
 import Data.Maybe
-import Data.List(isPrefixOf)
+import Data.List(isPrefixOf,isInfixOf,partition)
 import qualified Data.Map as Map
 import qualified Data.ByteString.Char8 as BS
 import qualified Text.ParserCombinators.ReadP as RP
@@ -41,6 +42,7 @@ import System.Directory
 import Control.Exception
 import Control.Monad
 import Data.Version
+import Text.PrettyPrint (render)
 import GF.System.Signal
 --import System.IO.Error (try)
 #ifdef mingw32_HOST_OS
@@ -120,19 +122,34 @@ loop opts gfenv0 = do
                
                (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
                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
                                  Bad s -> putStrLn $ s
              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
              let stop = case ws of
                    ('-':'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
         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 = do
   path <- getAppUserDataDirectory "gf_history"