Add support for literals

src/compiler/GF/Compile/GrammarToLPGF.hs

@@ -53,13 +53,21 @@ mkAbstract :: (ErrorMonad err) => C.Abstract -> err (CId, L.Abstract)
 mkAbstract (C.Abstract modId flags cats funs) = return (mdi2i modId, L.Abstract {})
 
 mkConcrete :: (ErrorMonad err) => Bool -> C.Abstract -> C.Concrete -> err (CId, L.Concrete)
-mkConcrete debug (C.Abstract _ _ _ funs) (C.Concrete modId absModId flags params0 lincats lindefs0) = do
+mkConcrete debug (C.Abstract _ _ _ funs) (C.Concrete modId absModId flags params0 lincats0 lindefs0) = do
   let
     -- Some transformations on canonical grammar
 
     params :: [C.ParamDef]
     params = inlineParamAliases params0
 
+    lincats :: [C.LincatDef]
+    lincats = s:i:f:lincats0
+      where
+        ss = C.RecordType [C.RecordRow (C.LabelId "s") C.StrType]
+        s = C.LincatDef (C.CatId "String") ss
+        i = C.LincatDef (C.CatId "Int") ss
+        f = C.LincatDef (C.CatId "Float") ss
+
     lindefs :: [C.LinDef]
     lindefs =
       [ C.LinDef funId varIds linValue'

src/runtime/haskell/LPGF.hs

@@ -10,7 +10,7 @@ module LPGF where
 
 import PGF (Language)
 import PGF.CId
-import PGF.Expr (Expr)
+import PGF.Expr (Expr, Literal (..))
 import PGF.Tree (Tree (..), expr2tree, prTree)
 
 import qualified Control.Exception as EX
@@ -23,6 +23,7 @@ import qualified Data.Map.Strict as Map
 import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as TE
+import Numeric (showFFloat)
 import Text.Printf (printf)
 
 import Prelude hiding ((!!))
@@ -191,12 +192,18 @@ linearizeConcreteText :: Concrete -> Expr -> Text
 linearizeConcreteText concr expr = lin2string $ lin (expr2tree expr)
   where
     lin :: Tree -> LinFun
-    lin tree = case tree of
+    lin = \case
       Fun f as ->
         case Map.lookup f (lins concr) of
           Just t -> eval cxt t
             where cxt = Context { cxToks = toks concr, cxArgs = map lin as }
           _ -> Missing f
+      Lit l -> Tuple [Token (T.pack s)]
+        where
+          s = case l of
+            LStr s -> s
+            LInt i -> show i
+            LFlt f -> showFFloat (Just 6) f ""
       x -> error $ printf "Cannot lin: %s" (prTree x)
 
 -- | Run a compatation and catch any exception/errors.

testsuite/lpgf/unittests/Literals.gf

@@ -4,4 +4,6 @@ abstract Literals = {
     mkString : String -> S ;
     mkInt : Int -> S ;
     mkFloat : Float -> S ;
+
+    and : S -> S -> S ;
 }

testsuite/lpgf/unittests/Literals.treebank

@@ -1,5 +1,5 @@
 Literals: mkString "hello"
-LiteralsCnc: hello
+LiteralsCnc: « hello »
 
 Literals: mkInt 123
 LiteralsCnc: 123
@@ -7,3 +7,6 @@ LiteralsCnc: 123
 Literals: mkFloat 30.809000
 LiteralsCnc: 30.809000
 
+Literals: and (mkString "one") (mkString "two")
+LiteralsCnc: « one » and « two »
+

testsuite/lpgf/unittests/Literals.trees

@@ -1,3 +1,4 @@
 mkString "hello"
 mkInt 123
 mkFloat 30.809
+and (mkString "one") (mkString "two")

testsuite/lpgf/unittests/LiteralsCnc.gf

@@ -1,7 +1,9 @@
 concrete LiteralsCnc of Literals = open Prelude in {
   lincat S = SS ;
   lin
-    mkString s = s ;
+    mkString s = ss ("«" ++ s.s ++ "»") ;
     mkInt s = s ;
     mkFloat s = s ;
+
+    and s1 s2 = ss (s1.s ++ "and" ++ s2.s) ;
 }