Add support for pre

src/compiler/GF/Compile/GrammarToLPGF.hs

@@ -13,7 +13,7 @@ import GF.Infra.UseIO (IOE)
 import GF.Text.Pretty (pp, render)
 
 import qualified Control.Monad.State as CMS
-import Control.Monad (unless, forM_)
+import Control.Monad (unless, forM, forM_)
 import Data.Either (lefts, rights)
 import Data.List (elemIndex, find, groupBy, sortBy)
 import qualified Data.Map as Map
@@ -128,7 +128,12 @@ mkCanon2lpgf opts gr am = do
                 ix <- eitherElemIndex (C.VarId v) varIds
                 return $ L.LFArgument (ix+1)
 
-              -- PreValue [([String], LinValue)] LinValue -- TODO pre not supported
+              C.PreValue pts df -> do
+                pts' <- forM pts $ \(pfxs, lv) -> do
+                  lv' <- val2lin lv
+                  return (pfxs, lv')
+                df' <- val2lin df
+                return $ L.LFPre pts' df'
 
               -- specific case when lhs is variable into function
               C.Projection (C.VarValue (C.VarValueId (C.Unqual v))) lblId -> 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.List (isPrefixOf)
 import qualified Data.Map as Map
 import Text.Printf (printf)
 
@@ -45,9 +46,12 @@ data Concr = Concr {
 
 -- | Linearisation function
 data LinFun =
+  -- Additions
     LFError String -- ^ a runtime error, should probably not be supported at all
   | LFBind -- ^ bind token
+  | LFPre [([String], LinFun)] LinFun
 
+  -- From original definition in paper
   | LFEmpty
   | LFToken String
   | LFConcat LinFun LinFun
@@ -124,6 +128,10 @@ eval :: Context -> LinFun -> LinFun
 eval cxt t = case t of
   LFError err -> error err
   LFBind -> LFBind
+  LFPre pts df -> LFPre pts' df'
+    where
+      pts' = [ (strs, eval cxt t) | (strs,t) <- pts]
+      df' = eval cxt df
 
   LFEmpty -> LFEmpty
   LFToken tok -> LFToken tok
@@ -148,6 +156,11 @@ lin2string l = case l of
   LFBind -> "" -- when encountered at beginning/end
   LFToken tok -> tok
   LFTuple [l] -> lin2string l
+  LFConcat (LFPre pts df) l2 -> lin2string $ LFConcat l1 l2
+    where
+      l2' = lin2string l2
+      matches = [ l | (pfxs, l) <- pts, any (`isPrefixOf` l2') pfxs ]
+      l1 = if null matches then df else head matches
   LFConcat l1 (LFConcat LFBind l2) -> lin2string l1 ++ lin2string l2
   LFConcat l1 l2 -> unwords $ filter (not.null) [lin2string l1, lin2string l2]
   x -> printf "[%s]" (show x)

testsuite/lpgf/Pre.gf

@@ -0,0 +1,7 @@
+abstract Pre = {
+  cat S; N; Det;
+  fun
+    ant, dog: N ;
+    a, the: Det ;
+    mkS : Det -> N -> S;
+}

testsuite/lpgf/Pre.treebank

@@ -0,0 +1,12 @@
+Pre: mkS a ant
+PreCnc: an ant
+
+Pre: mkS the ant
+PreCnc: the ant
+
+Pre: mkS a dog
+PreCnc: a dog
+
+Pre: mkS the dog
+PreCnc: the dog
+

testsuite/lpgf/Pre.trees

@@ -0,0 +1,4 @@
+mkS a ant
+mkS the ant
+mkS a dog
+mkS the dog

testsuite/lpgf/PreCnc.gf

@@ -0,0 +1,15 @@
+concrete PreCnc of Pre = {
+  lincat
+    S = { s : Str } ;
+    N = { s : Str } ;
+    Det = { s : Str } ;
+  lin
+    ant = { s = "ant" } ;
+    dog = { s = "dog" } ;
+    a = { s = pre {
+      "a"|"e"|"i"|"o"|"u" => "an" ;
+      _ => "a"
+    } } ;
+    the = { s = "the" } ;
+    mkS det n = { s = det.s ++ n.s } ;
+}

testsuite/lpgf/run.hs

@@ -18,6 +18,7 @@ main = do
   doGrammar "Bind"
   doGrammar "Tables"
   doGrammar "Params"
+  doGrammar "Pre"
   doGrammar "Walking"
   doGrammar "Foods"
   -- doGrammar' "Foods" ["Fre"]