added command ai which prints information about given identifier

2 files changed, 31 insertions, 5 deletions

diff --git a/src/GF/Command/Commands.hs b/src/GF/Command/Commands.hs
index 7534554de..8f82b468f 100644
--- a/src/GF/Command/Commands.hs
+++ b/src/GF/Command/Commands.hs
@@ -35,6 +35,7 @@ import GF.Text.Coding
 import Data.Maybe
 import qualified Data.Map as Map
 import System.Cmd
+import Text.PrettyPrint
 
 import Debug.Trace
 
@@ -586,6 +587,30 @@ allCommands cod env@(pgf, mos) = Map.fromList [
        ("append","append to file, instead of overwriting it")
        ],
      flags = [("file","the output filename")] 
+     }),
+  ("ai", emptyCommandInfo {
+     longname = "abstract_info",
+     syntax = "ai IDENTIFIER",
+     synopsis = "provides an information about a function or a category from the abstract syntax",
+     explanation = unlines [
+       "The command has one argument which is either function or a category defined in",
+       "the abstract syntax of the current grammar. If the argument is a function then",
+       "its type is printed out. If it is a category then the category definition is printed"
+       ],
+     exec = \opts arg -> do
+       case arg of
+         [Fun id []] -> case Map.lookup id (funs (abstract pgf)) of
+                          Just (ty,def) -> putStrLn (render (text "fun" <+> text (prCId id) <+> colon    <+> ppType 0 ty $$
+                                                             if def == EEq []
+                                                               then empty
+                                                               else text "def" <+> text (prCId id) <+> char '=' <+> ppExpr 0 def))
+                          Nothing       -> case Map.lookup id (cats (abstract pgf)) of
+                                             Just hyps -> putStrLn (render (text "cat" <+>
+                                                                            text (prCId id) <+>
+                                                                            hsep (map ppHypo hyps)))
+                                             Nothing   -> putStrLn "unknown identifier"
+         _           -> putStrLn "a single identifier is expected from the command"
+       return void
      })
   ]
  where
diff --git a/src/PGF/Type.hs b/src/PGF/Type.hs
index fec8c0ff2..8c513ffd4 100644
--- a/src/PGF/Type.hs
+++ b/src/PGF/Type.hs
@@ -1,6 +1,6 @@
 module PGF.Type ( Type(..), Hypo(..),

                   readType, showType,

-                  pType, ppType ) where

+                  pType, ppType, ppHypo ) where

 

 import PGF.CId

 import PGF.Expr

@@ -67,12 +67,13 @@ ppType d (DTyp ctxt cat args)
   | null ctxt = ppRes cat args

   | otherwise = ppParens (d > 0) (foldr ppCtxt (ppRes cat args) ctxt)

   where

-    ppCtxt (Hyp x typ) doc

-      | x == wildCId = ppType 1 typ PP.<+> PP.text "->" PP.<+> doc

-      | otherwise    = PP.parens (PP.text (prCId x) PP.<+> PP.char ':' PP.<+> ppType 0 typ) PP.<+> PP.text "->" PP.<+> doc

-

+    ppCtxt hyp doc = ppHypo hyp PP.<+> PP.text "->" PP.<+> doc

     ppRes cat es = PP.text (prCId cat) PP.<+> PP.hsep (map (ppExpr 2) es)

 

+ppHypo (Hyp x typ)

+  | x == wildCId = ppType 1 typ

+  | otherwise    = PP.parens (PP.text (prCId x) PP.<+> PP.char ':' PP.<+> ppType 0 typ)

+

 ppParens :: Bool -> PP.Doc -> PP.Doc

 ppParens True  = PP.parens

 ppParens False = id