started create/drop with lin & lincat

src/compiler/GF/Command/Abstract.hs

@@ -16,8 +16,12 @@ data Command
 data TransactionCommand
    = CreateFun [Option] Fun Type
    | CreateCat [Option] Cat [Hypo]
+   | CreateLin [Option] Fun Term
+   | CreateLincat [Option] Cat Term
    | DropFun [Option] Fun
    | DropCat [Option] Cat
+   | DropLin [Option] Fun
+   | DropLincat [Option] Cat
    deriving Show
 
 data Option

src/compiler/GF/Command/Parse.hs

@@ -1,7 +1,9 @@
 module GF.Command.Parse(readCommandLine, readTransactionCommand, pCommand) where
 
 import PGF(pExpr,pIdent)
-import PGF2(readType,readContext)
+import PGF2(BindType(..),readType,readContext)
+import GF.Infra.Ident(identS)
+import GF.Grammar.Grammar(Term(Abs))
 import GF.Grammar.Parser(runPartial,pTerm)
 import GF.Command.Abstract
 
@@ -73,6 +75,33 @@ pTransactionCommand = do
           | take 1 cmd == "d" -> do
                 c <- pIdent
                 return (DropCat opts c)
+    "lin" | take 1 cmd == "c" -> do
+               f <- pIdent
+               skipSpaces
+               args <- sepBy pIdent skipSpaces
+               skipSpaces
+               char '='
+               skipSpaces
+               t  <- readS_to_P (\s -> case runPartial pTerm s of
+                                         Right (s,t) -> [(t,s)]
+                                         _ -> [])
+               return (CreateLin opts f (foldr (Abs Explicit . identS) t args))
+          | take 1 cmd == "d" -> do
+                f <- pIdent
+                return (DropLin opts f)
+    "lincat"
+          | take 1 cmd == "c" -> do
+               f <- pIdent
+               skipSpaces
+               char '='
+               skipSpaces
+               t  <- readS_to_P (\s -> case runPartial pTerm s of
+                                         Right (s,t) -> [(t,s)]
+                                         _ -> [])
+               return (CreateLincat opts f t)
+          | take 1 cmd == "d" -> do
+                f <- pIdent
+                return (DropLincat opts f)
     _     -> pfail
 
 pOption = do

src/compiler/GF/Interactive.hs

@@ -242,12 +242,45 @@ transactionCommand (CreateCat opts c ctxt) pgf = do
     Left msg -> putStrLnE msg
     Right ty -> do lift $ modifyPGF pgf (createCategory c ctxt prob)
                    return ()
+transactionCommand (CreateLin opts f t) pgf = do
+  lang <- optLang pgf opts
+  lift $ modifyPGF pgf (alterConcrete lang (createLin f []))
+  return ()
+transactionCommand (CreateLincat opts c t) pgf = do
+  lang <- optLang pgf opts
+  lift $ modifyPGF pgf (alterConcrete lang (createLincat c [] [] []))
+  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 ()
+transactionCommand (DropLin opts f) pgf = do
+  lang <- optLang pgf opts
+  lift $ modifyPGF pgf (alterConcrete lang (dropLin f))
+  return ()
+transactionCommand (DropLincat opts c) pgf = do
+  lang <- optLang pgf opts
+  lift $ modifyPGF pgf (alterConcrete lang (dropLincat c))
+  return ()
+
+optLang pgf opts =
+  case Map.keys (languages pgf) of
+    [lang] -> completeLang (valStrOpts "lang" lang opts)
+    _      -> case valStrOpts "lang" "" opts of
+                ""   -> fail "Specify a language to change"
+                lang -> completeLang lang
+  where
+    langs = languages pgf
+
+    completeLang la
+      | Map.member la  langs = return la
+      | Map.member la' langs = return la'
+      | otherwise            = fail "Unknown language"
+      where
+        la' = abstractName pgf ++ la
+
 
 -- | Commands that work on 'GFEnv'
 moreCommands = [