Add support for CAPIT and ALL_CAPIT

src/compiler/GF/Compile/GrammarToLPGF.hs

@@ -95,8 +95,8 @@ mkCanon2lpgf opts gr am = do
                 "BIND" -> return L.LFBind
                 "SOFT_BIND" -> return L.LFBind
                 "SOFT_SPACE" -> return L.LFSpace
-                -- "CAPIT" ->
-                -- "ALL_CAPIT" ->
+                "CAPIT" -> return L.LFCapit
+                "ALL_CAPIT" -> return L.LFAllCapit
                 _ -> Left $ printf "Unknown predef function: %s" pid
 
               C.RecordValue rrvs -> do

src/runtime/haskell/LPGF.hs

@@ -9,6 +9,7 @@ import PGF.Expr (Expr)
 import PGF.Tree (Tree (..), expr2tree, prTree)
 
 import Data.Binary (Binary, get, put, encodeFile, decodeFile)
+import Data.Char (toUpper)
 import Data.List (isPrefixOf)
 import qualified Data.Map as Map
 import Text.Printf (printf)
@@ -50,6 +51,8 @@ data LinFun =
     LFError String -- ^ a runtime error, should probably not be supported at all
   | LFBind
   | LFSpace
+  | LFCapit
+  | LFAllCapit
   | LFPre [([String], LinFun)] LinFun
 
   -- From original definition in paper
@@ -161,6 +164,8 @@ lin2string l = case l of
       l1 = if null matches then df else head matches
   LFConcat l1 (LFConcat LFBind l2) -> lin2string l1 ++ lin2string l2
   LFConcat l1 (LFConcat LFSpace l2) -> lin2string $ LFConcat l1 l2
+  LFConcat LFCapit l2 -> let l = lin2string l2 in toUpper (head l) : tail l
+  LFConcat LFAllCapit l2 -> let tks = words (lin2string l2) in unwords $ map toUpper (head tks) : tail tks
   LFConcat l1 l2 -> unwords $ filter (not.null) [lin2string l1, lin2string l2]
   x -> printf "[%s]" (show x)
 

testsuite/lpgf/Bind.gf

@@ -7,4 +7,6 @@ abstract Bind = {
     bind : S -> S -> S ;
     softbind : S -> S -> S ;
     softspace : S -> S -> S ;
+    capit : S -> S ;
+    allcapit : S -> S ;
 }

testsuite/lpgf/Bind.treebank

@@ -15,3 +15,6 @@ BindCnc: hello theregoodbye
 
 Bind: softspace f1 f2
 BindCnc: hello there goodbye
+
+Bind: concat (capit f1) (allcapit f2)
+BindCnc: Hello there GOODBYE

testsuite/lpgf/Bind.trees

@@ -4,3 +4,4 @@ concat f1 f2
 bind f1 f2
 softbind f1 f2
 softspace f1 f2
+concat (capit f1) (allcapit f2)

testsuite/lpgf/BindCnc.gf

@@ -8,4 +8,6 @@ concrete BindCnc of Bind = open Prelude in {
     bind a b = ss (a.s ++ BIND ++ b.s) ;
     softbind a b = ss (a.s ++ SOFT_BIND ++ b.s) ;
     softspace a b = ss (a.s ++ SOFT_SPACE ++ b.s) ;
+    capit a = ss (CAPIT ++ a.s) ;
+    allcapit a = ss (ALL_CAPIT ++ a.s) ;
 }