From f4164303d087acce230deec458f80b8a47f0baeb Mon Sep 17 00:00:00 2001
From: krasimir <krasimir@chalmers.se>
Date: Tue, 12 May 2009 20:52:18 +0000
Subject: [PATCH] added command ai which prints information about given
 identifier

---
 src/GF/Command/Commands.hs | 25 +++++++++++++++++++++++++
 src/PGF/Type.hs            | 11 ++++++-----
 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