diff --git a/src/compiler/GF/Compile/GrammarToLPGF.hs b/src/compiler/GF/Compile/GrammarToLPGF.hs index 81290d4f3..9b4b78300 100644 --- a/src/compiler/GF/Compile/GrammarToLPGF.hs +++ b/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 diff --git a/src/runtime/haskell/LPGF.hs b/src/runtime/haskell/LPGF.hs index fd9a78a98..3d1390c2c 100644 --- a/src/runtime/haskell/LPGF.hs +++ b/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) diff --git a/testsuite/lpgf/Pre.gf b/testsuite/lpgf/Pre.gf new file mode 100644 index 000000000..5f8955d26 --- /dev/null +++ b/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; +} diff --git a/testsuite/lpgf/Pre.treebank b/testsuite/lpgf/Pre.treebank new file mode 100644 index 000000000..d7eedf79c --- /dev/null +++ b/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 + diff --git a/testsuite/lpgf/Pre.trees b/testsuite/lpgf/Pre.trees new file mode 100644 index 000000000..c3ccbcd17 --- /dev/null +++ b/testsuite/lpgf/Pre.trees @@ -0,0 +1,4 @@ +mkS a ant +mkS the ant +mkS a dog +mkS the dog diff --git a/testsuite/lpgf/PreCnc.gf b/testsuite/lpgf/PreCnc.gf new file mode 100644 index 000000000..0a7927185 --- /dev/null +++ b/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 } ; +} diff --git a/testsuite/lpgf/run.hs b/testsuite/lpgf/run.hs index db90d9df6..b33daa211 100644 --- a/testsuite/lpgf/run.hs +++ b/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"]