added commands create cat & drop cat

src/compiler/GF/Command/Abstract.hs

@@ -1,6 +1,6 @@
 module GF.Command.Abstract(module GF.Command.Abstract,Expr,showExpr,Literal(..),Term) where
 
-import PGF2(Expr,showExpr,Literal(..),Type)
+import PGF2
 import GF.Grammar.Grammar(Term)
 
 type Ident = String
@@ -14,8 +14,10 @@ data Command
    deriving Show
 
 data TransactionCommand
-   = CreateFun [Option] Ident Type
-   | DropFun [Option] Ident
+   = CreateFun [Option] Fun Type
+   | CreateCat [Option] Cat [Hypo]
+   | DropFun [Option] Fun
+   | DropCat [Option] Cat
    deriving Show
 
 data Option

src/compiler/GF/Command/Parse.hs

@@ -1,7 +1,7 @@
 module GF.Command.Parse(readCommandLine, readTransactionCommand, pCommand) where
 
 import PGF(pExpr,pIdent)
-import PGF2(readType)
+import PGF2(readType,readContext)
 import GF.Grammar.Parser(runPartial,pTerm)
 import GF.Command.Abstract
 
@@ -63,6 +63,16 @@ pTransactionCommand = do
           | take 1 cmd == "d" -> do
                 f <- pIdent
                 return (DropFun opts f)
+    "cat" | take 1 cmd == "c" -> do
+               c <- pIdent
+               skipSpaces
+               ctxt <- readS_to_P (\s -> case readContext s of
+                                           Just ty -> [(ty,"")]
+                                           Nothing -> [])
+               return (CreateCat opts c ctxt)
+          | take 1 cmd == "d" -> do
+                c <- pIdent
+                return (DropCat opts c)
     _     -> pfail
 
 pOption = do

src/compiler/GF/Interactive.hs

@@ -236,9 +236,18 @@ transactionCommand (CreateFun opts f ty) pgf = do
     Left msg -> putStrLnE msg
     Right ty -> do lift $ modifyPGF pgf (createFunction f ty 0 [] prob)
                    return ()
+transactionCommand (CreateCat opts c ctxt) pgf = do
+  let prob = realToFrac (valFltOpts "prob" (1/0) opts)
+  case checkContext pgf ctxt of
+    Left msg -> putStrLnE msg
+    Right ty -> do lift $ modifyPGF pgf (createCategory c ctxt prob)
+                   return ()
 transactionCommand (DropFun opts f) pgf = do
   lift $ modifyPGF pgf (dropFunction f)
   return ()
+transactionCommand (DropCat opts c) pgf = do
+  lift $ modifyPGF pgf (dropCategory c)
+  return ()
 
 -- | Commands that work on 'GFEnv'
 moreCommands = [