Change Data.Text to String as a test, seemingly makes no difference.

Bul ✓
Cat ✗
Chi ✓
Dan ✓
Dut ✓
Eng ✓
Est ✓
Fin ✓
Fre ✗
Ger ✓
Hin ✓
Ita ✗
Jpn ✓
Lav ✓
Nor ✓
Pol ✓
Ron ✓
Snd ✗
Spa ✓
Swe ✓
Tha ✓
Urd ✓

Passed 18 | Failed 4 | Total 22

.gitignore

@@ -5,6 +5,7 @@
 *.jar
 *.gfo
 *.pgf
+*.lpgf
 debian/.debhelper
 debian/debhelper-build-stamp
 debian/gf

gf.cabal

@@ -86,7 +86,10 @@ Library
                  -- For compatability with ghc < 8
                  -- We need transformers-compat >= 0.6.3, but that is only in newer snapshots where it is redundant.
                  transformers-compat,
-                 ghc-prim
+                 ghc-prim,
+                 text,
+                 hashable,
+                 unordered-containers
   hs-source-dirs: src/runtime/haskell
 
   other-modules:
@@ -107,6 +110,7 @@ Library
     PGF
     PGF.Internal
     PGF.Haskell
+    LPGF
 
   other-modules:
     PGF.Data
@@ -184,6 +188,7 @@ Library
     GF.Compile.Export
     GF.Compile.GenerateBC
     GF.Compile.GeneratePMCFG
+    GF.Compile.GrammarToLPGF
     GF.Compile.GrammarToPGF
     GF.Compile.Multi
     GF.Compile.Optimize
@@ -213,6 +218,7 @@ Library
     GF.Data.ErrM
     GF.Data.Graph
     GF.Data.Graphviz
+    GF.Data.IntMapBuilder
     GF.Data.Relation
     GF.Data.Str
     GF.Data.Utilities
@@ -353,3 +359,402 @@ test-suite gf-tests
   hs-source-dirs: testsuite
   build-depends:  base>=4.3 && <5, Cabal>=1.8, directory, filepath, process
   default-language:    Haskell2010
+
+test-suite lpgf
+  type: exitcode-stdio-1.0
+  main-is: test.hs
+  hs-source-dirs:
+    src/compiler
+    src/runtime/haskell
+    testsuite/lpgf
+  other-modules:
+    Data.Binary
+    Data.Binary.Builder
+    Data.Binary.Get
+    Data.Binary.IEEE754
+    Data.Binary.Put
+    GF
+    GF.Command.Abstract
+    GF.Command.CommandInfo
+    GF.Command.Commands
+    GF.Command.CommonCommands
+    GF.Command.Help
+    GF.Command.Importing
+    GF.Command.Interpreter
+    GF.Command.Messages
+    GF.Command.Parse
+    GF.Command.SourceCommands
+    GF.Command.TreeOperations
+    GF.Compile
+    GF.Compile.CFGtoPGF
+    GF.Compile.CheckGrammar
+    GF.Compile.Compute.ConcreteNew
+    GF.Compile.Compute.Predef
+    GF.Compile.Compute.Value
+    GF.Compile.ConcreteToHaskell
+    GF.Compile.ExampleBased
+    GF.Compile.Export
+    GF.Compile.GenerateBC
+    GF.Compile.GeneratePMCFG
+    GF.Compile.GetGrammar
+    GF.Compile.GrammarToCanonical
+    GF.Compile.GrammarToLPGF
+    GF.Compile.GrammarToPGF
+    GF.Compile.Multi
+    GF.Compile.Optimize
+    GF.Compile.PGFtoHaskell
+    GF.Compile.PGFtoJava
+    GF.Compile.PGFtoJS
+    GF.Compile.PGFtoJSON
+    GF.Compile.PGFtoProlog
+    GF.Compile.PGFtoPython
+    GF.Compile.ReadFiles
+    GF.Compile.Rename
+    GF.Compile.SubExOpt
+    GF.Compile.Tags
+    GF.Compile.ToAPI
+    GF.Compile.TypeCheck.Abstract
+    GF.Compile.TypeCheck.ConcreteNew
+    GF.Compile.TypeCheck.Primitives
+    GF.Compile.TypeCheck.RConcrete
+    GF.Compile.TypeCheck.TC
+    GF.Compile.Update
+    GF.CompileInParallel
+    GF.CompileOne
+    GF.Compiler
+    GF.Data.BacktrackM
+    GF.Data.ErrM
+    GF.Data.Graph
+    GF.Data.Graphviz
+    GF.Data.IntMapBuilder
+    GF.Data.Operations
+    GF.Data.Relation
+    GF.Data.Str
+    GF.Data.Utilities
+    GF.Data.XML
+    GF.Grammar
+    GF.Grammar.Analyse
+    GF.Grammar.Binary
+    GF.Grammar.BNFC
+    GF.Grammar.Canonical
+    GF.Grammar.CanonicalJSON
+    GF.Grammar.CFG
+    GF.Grammar.EBNF
+    GF.Grammar.Grammar
+    GF.Grammar.Lexer
+    GF.Grammar.Lockfield
+    GF.Grammar.Lookup
+    GF.Grammar.Macros
+    GF.Grammar.Parser
+    GF.Grammar.PatternMatch
+    GF.Grammar.Predef
+    GF.Grammar.Printer
+    GF.Grammar.ShowTerm
+    GF.Grammar.Unify
+    GF.Grammar.Values
+    GF.Haskell
+    GF.Infra.BuildInfo
+    GF.Infra.CheckM
+    GF.Infra.Concurrency
+    GF.Infra.Dependencies
+    GF.Infra.GetOpt
+    GF.Infra.Ident
+    GF.Infra.Location
+    GF.Infra.Option
+    GF.Infra.SIO
+    GF.Infra.UseIO
+    GF.Interactive
+    GF.JavaScript.AbsJS
+    GF.JavaScript.PrintJS
+    GF.Main
+    GF.Quiz
+    GF.Speech.CFGToFA
+    GF.Speech.FiniteState
+    GF.Speech.GSL
+    GF.Speech.JSGF
+    GF.Speech.PGFToCFG
+    GF.Speech.PrRegExp
+    GF.Speech.RegExp
+    GF.Speech.SISR
+    GF.Speech.SLF
+    GF.Speech.SRG
+    GF.Speech.SRGS_ABNF
+    GF.Speech.SRGS_XML
+    GF.Speech.VoiceXML
+    GF.Support
+    GF.System.Catch
+    GF.System.Concurrency
+    GF.System.Console
+    GF.System.Directory
+    GF.System.Process
+    GF.System.Signal
+    GF.Text.Clitics
+    GF.Text.Coding
+    GF.Text.Lexing
+    GF.Text.Pretty
+    GF.Text.Transliterations
+    LPGF
+    PGF
+    PGF.Binary
+    PGF.ByteCode
+    PGF.CId
+    PGF.Data
+    PGF.Expr
+    PGF.Forest
+    PGF.Generate
+    PGF.Internal
+    PGF.Linearize
+    PGF.Macros
+    PGF.Morphology
+    PGF.OldBinary
+    PGF.Optimize
+    PGF.Paraphrase
+    PGF.Parse
+    PGF.Printer
+    PGF.Probabilistic
+    PGF.Tree
+    PGF.TrieMap
+    PGF.Type
+    PGF.TypeCheck
+    PGF.Utilities
+    PGF.VisualizeTree
+    Paths_gf
+  if flag(interrupt)
+    cpp-options: -DUSE_INTERRUPT
+    other-modules: GF.System.UseSignal
+  else
+    other-modules: GF.System.NoSignal
+  build-depends:
+    ansi-terminal,
+    array,
+    base>=4.6 && <5,
+    bytestring,
+    containers,
+    directory,
+    filepath,
+    ghc-prim,
+    hashable,
+    haskeline,
+    json,
+    mtl,
+    parallel>=3,
+    pretty,
+    process,
+    random,
+    terminfo,
+    text,
+    time,
+    transformers-compat,
+    unix,
+    unordered-containers,
+    utf8-string
+  default-language: Haskell2010
+
+benchmark lpgf-bench
+  type: exitcode-stdio-1.0
+  main-is: bench.hs
+  hs-source-dirs:
+    src/compiler
+    src/runtime/haskell
+    testsuite/lpgf
+  other-modules:
+    Data.Binary
+    Data.Binary.Builder
+    Data.Binary.Get
+    Data.Binary.IEEE754
+    Data.Binary.Put
+    GF
+    GF.Command.Abstract
+    GF.Command.CommandInfo
+    GF.Command.Commands
+    GF.Command.CommonCommands
+    GF.Command.Help
+    GF.Command.Importing
+    GF.Command.Interpreter
+    GF.Command.Messages
+    GF.Command.Parse
+    GF.Command.SourceCommands
+    GF.Command.TreeOperations
+    GF.Compile
+    GF.Compile.CFGtoPGF
+    GF.Compile.CheckGrammar
+    GF.Compile.Compute.ConcreteNew
+    GF.Compile.Compute.Predef
+    GF.Compile.Compute.Value
+    GF.Compile.ConcreteToHaskell
+    GF.Compile.ExampleBased
+    GF.Compile.Export
+    GF.Compile.GenerateBC
+    GF.Compile.GeneratePMCFG
+    GF.Compile.GetGrammar
+    GF.Compile.GrammarToCanonical
+    GF.Compile.GrammarToLPGF
+    GF.Compile.GrammarToPGF
+    GF.Compile.Multi
+    GF.Compile.Optimize
+    GF.Compile.PGFtoHaskell
+    GF.Compile.PGFtoJS
+    GF.Compile.PGFtoJSON
+    GF.Compile.PGFtoJava
+    GF.Compile.PGFtoProlog
+    GF.Compile.PGFtoPython
+    GF.Compile.ReadFiles
+    GF.Compile.Rename
+    GF.Compile.SubExOpt
+    GF.Compile.Tags
+    GF.Compile.ToAPI
+    GF.Compile.TypeCheck.Abstract
+    GF.Compile.TypeCheck.ConcreteNew
+    GF.Compile.TypeCheck.Primitives
+    GF.Compile.TypeCheck.RConcrete
+    GF.Compile.TypeCheck.TC
+    GF.Compile.Update
+    GF.CompileInParallel
+    GF.CompileOne
+    GF.Compiler
+    GF.Data.BacktrackM
+    GF.Data.ErrM
+    GF.Data.Graph
+    GF.Data.Graphviz
+    GF.Data.IntMapBuilder
+    GF.Data.Operations
+    GF.Data.Relation
+    GF.Data.Str
+    GF.Data.Utilities
+    GF.Data.XML
+    GF.Grammar
+    GF.Grammar.Analyse
+    GF.Grammar.BNFC
+    GF.Grammar.Binary
+    GF.Grammar.CFG
+    GF.Grammar.Canonical
+    GF.Grammar.CanonicalJSON
+    GF.Grammar.EBNF
+    GF.Grammar.Grammar
+    GF.Grammar.Lexer
+    GF.Grammar.Lockfield
+    GF.Grammar.Lookup
+    GF.Grammar.Macros
+    GF.Grammar.Parser
+    GF.Grammar.PatternMatch
+    GF.Grammar.Predef
+    GF.Grammar.Printer
+    GF.Grammar.ShowTerm
+    GF.Grammar.Unify
+    GF.Grammar.Values
+    GF.Haskell
+    GF.Infra.BuildInfo
+    GF.Infra.CheckM
+    GF.Infra.Concurrency
+    GF.Infra.Dependencies
+    GF.Infra.GetOpt
+    GF.Infra.Ident
+    GF.Infra.Location
+    GF.Infra.Option
+    GF.Infra.SIO
+    GF.Infra.UseIO
+    GF.Interactive
+    GF.JavaScript.AbsJS
+    GF.JavaScript.PrintJS
+    GF.Main
+    GF.Quiz
+    GF.Speech.CFGToFA
+    GF.Speech.FiniteState
+    GF.Speech.GSL
+    GF.Speech.JSGF
+    GF.Speech.PGFToCFG
+    GF.Speech.PrRegExp
+    GF.Speech.RegExp
+    GF.Speech.SISR
+    GF.Speech.SLF
+    GF.Speech.SRG
+    GF.Speech.SRGS_ABNF
+    GF.Speech.SRGS_XML
+    GF.Speech.VoiceXML
+    GF.Support
+    GF.System.Catch
+    GF.System.Concurrency
+    GF.System.Console
+    GF.System.Directory
+    GF.System.Process
+    GF.System.Signal
+    GF.Text.Clitics
+    GF.Text.Coding
+    GF.Text.Lexing
+    GF.Text.Pretty
+    GF.Text.Transliterations
+    LPGF
+    PGF
+    PGF.Binary
+    PGF.ByteCode
+    PGF.CId
+    PGF.Data
+    PGF.Expr
+    PGF.Expr
+    PGF.Forest
+    PGF.Generate
+    PGF.Internal
+    PGF.Linearize
+    PGF.Macros
+    PGF.Morphology
+    PGF.OldBinary
+    PGF.Optimize
+    PGF.Paraphrase
+    PGF.Parse
+    PGF.Printer
+    PGF.Probabilistic
+    PGF.Tree
+    PGF.TrieMap
+    PGF.Type
+    PGF.TypeCheck
+    PGF.Utilities
+    PGF.VisualizeTree
+    PGF2
+    PGF2.Expr
+    PGF2.Type
+    PGF2.FFI
+    Paths_gf
+  if flag(interrupt)
+    cpp-options: -DUSE_INTERRUPT
+    other-modules: GF.System.UseSignal
+  else
+    other-modules: GF.System.NoSignal
+
+  hs-source-dirs:
+    src/runtime/haskell-bind
+  other-modules:
+    PGF2
+    PGF2.FFI
+    PGF2.Expr
+    PGF2.Type
+  build-tools:     hsc2hs
+  extra-libraries: pgf gu
+  c-sources:       src/runtime/haskell-bind/utils.c
+  cc-options:      -std=c99
+
+  build-depends:
+    ansi-terminal,
+    array,
+    base>=4.6 && <5,
+    bytestring,
+    containers,
+    deepseq,
+    directory,
+    filepath,
+    ghc-prim,
+    hashable,
+    haskeline,
+    json,
+    mtl,
+    parallel>=3,
+    pretty,
+    process,
+    random,
+    terminfo,
+    text,
+    time,
+    transformers-compat,
+    unix,
+    unordered-containers,
+    utf8-string
+  default-language: Haskell2010

src/compiler/GF/Compile.hs

@@ -1,6 +1,7 @@
-module GF.Compile (compileToPGF, link, batchCompile, srcAbsName) where
+module GF.Compile (compileToPGF, compileToLPGF, link, linkl, batchCompile, srcAbsName) where
 
 import GF.Compile.GrammarToPGF(mkCanon2pgf)
+import GF.Compile.GrammarToLPGF(mkCanon2lpgf)
 import GF.Compile.ReadFiles(ModEnv,getOptionsFromFile,getAllFiles,
                             importsOfModule)
 import GF.CompileOne(compileOne)
@@ -14,7 +15,7 @@ import GF.Infra.UseIO(IOE,FullPath,liftIO,getLibraryDirectory,putIfVerb,
                       justModuleName,extendPathEnv,putStrE,putPointE)
 import GF.Data.Operations(raise,(+++),err)
 
-import Control.Monad(foldM,when,(<=<),filterM,liftM)
+import Control.Monad(foldM,when,(<=<),filterM)
 import GF.System.Directory(doesFileExist,getModificationTime)
 import System.FilePath((</>),isRelative,dropFileName)
 import qualified Data.Map as Map(empty,insert,elems) --lookup
@@ -24,12 +25,16 @@ import GF.Text.Pretty(render,($$),(<+>),nest)
 
 import PGF.Internal(optimizePGF)
 import PGF(PGF,defaultProbabilities,setProbabilities,readProbabilitiesFromFile)
+import LPGF(LPGF)
 
 -- | Compiles a number of source files and builds a 'PGF' structure for them.
 -- This is a composition of 'link' and 'batchCompile'.
 compileToPGF :: Options -> [FilePath] -> IOE PGF
 compileToPGF opts fs = link opts . snd =<< batchCompile opts fs
 
+compileToLPGF :: Options -> [FilePath] -> IOE LPGF
+compileToLPGF opts fs = linkl opts . snd =<< batchCompile opts fs
+
 -- | Link a grammar into a 'PGF' that can be used to 'PGF.linearize' and
 -- 'PGF.parse' with the "PGF" run-time system.
 link :: Options -> (ModuleName,Grammar) -> IOE PGF
@@ -42,6 +47,14 @@ link opts (cnc,gr) =
     return $ setProbabilities probs
            $ if flag optOptimizePGF opts then optimizePGF pgf else pgf
 
+-- | Link a grammar into a 'LPGF' that can be used for linearization only.
+linkl :: Options -> (ModuleName,Grammar) -> IOE LPGF
+linkl opts (cnc,gr) =
+  putPointE Normal opts "linking ... " $ do
+    let abs = srcAbsName gr cnc
+    lpgf <- mkCanon2lpgf opts gr abs
+    return lpgf
+
 -- | Returns the name of the abstract syntax corresponding to the named concrete syntax
 srcAbsName gr cnc = err (const cnc) id $ abstractOfConcrete gr cnc
 

src/compiler/GF/Compile/GrammarToCanonical.hs

@@ -17,7 +17,7 @@ import GF.Grammar.Predef(cPredef,cInts)
 import GF.Compile.Compute.Predef(predef)
 import GF.Compile.Compute.Value(Predefined(..))
 import GF.Infra.Ident(ModuleName(..),Ident,prefixIdent,showIdent,isWildIdent)
-import GF.Infra.Option(optionsPGF)
+import GF.Infra.Option(Options, optionsPGF)
 import PGF.Internal(Literal(..))
 import GF.Compile.Compute.ConcreteNew(normalForm,resourceValues)
 import GF.Grammar.Canonical as C
@@ -25,6 +25,7 @@ import Debug.Trace
 
 -- | Generate Canonical code for the named abstract syntax and all associated
 -- concrete syntaxes
+grammar2canonical :: Options -> ModuleName -> SourceGrammar -> C.Grammar
 grammar2canonical opts absname gr =
    Grammar (abstract2canonical absname gr)
            (map snd (concretes2canonical opts absname gr))

src/compiler/GF/Compile/GrammarToLPGF.hs

@@ -0,0 +1,447 @@
+module GF.Compile.GrammarToLPGF (mkCanon2lpgf) where
+
+import LPGF (LPGF (..))
+import qualified LPGF as L
+
+import PGF.CId
+import GF.Grammar.Grammar
+import qualified GF.Grammar.Canonical as C
+import GF.Compile.GrammarToCanonical (grammar2canonical)
+
+import GF.Data.Operations (ErrorMonad (..))
+import qualified GF.Data.IntMapBuilder as IntMapBuilder
+import GF.Infra.Option (Options)
+import GF.Infra.UseIO (IOE)
+import GF.Text.Pretty (pp, render)
+
+import Control.Applicative ((<|>))
+import Control.Monad (when, unless, forM, forM_)
+import qualified Control.Monad.State as CMS
+import Data.Either (lefts, rights)
+import qualified Data.IntMap as IntMap
+import Data.List (elemIndex)
+import qualified Data.List as L
+import qualified Data.Map.Strict as Map
+import Data.Maybe (fromJust, isJust)
+import System.Environment (lookupEnv)
+import System.FilePath ((</>), (<.>))
+import Text.Printf (printf)
+
+import qualified Debug.Trace
+trace x = Debug.Trace.trace ("> " ++ show x) (return ())
+
+mkCanon2lpgf :: Options -> SourceGrammar -> ModuleName -> IOE LPGF
+mkCanon2lpgf opts gr am = do
+  debug <- isJust <$> lookupEnv "DEBUG"
+  when debug $ do
+    ppCanonical debugDir canon
+    dumpCanonical debugDir canon
+  (an,abs) <- mkAbstract ab
+  cncs     <- mapM (mkConcrete debug) cncs
+  let lpgf = LPGF {
+    L.absname = an,
+    L.abstract = abs,
+    L.concretes = Map.fromList cncs
+  }
+  when debug $ ppLPGF debugDir lpgf
+  return lpgf
+  where
+    canon@(C.Grammar ab cncs) = grammar2canonical opts am gr
+
+    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.Concrete -> err (CId, L.Concrete)
+    mkConcrete debug (C.Concrete modId absModId flags params' lincats lindefs) = do
+      let
+        (C.Abstract _ _ _ funs) = ab
+        params = inlineParamAliases params'
+
+        -- Builds maps for lookups
+
+        paramValueMap :: Map.Map C.ParamId C.ParamDef -- constructor -> definition
+        paramValueMap = Map.fromList [ (v,d) | d@(C.ParamDef _ vs) <- params, (C.Param v _) <- vs ]
+
+        lincatMap :: Map.Map C.CatId C.LincatDef
+        lincatMap = Map.fromList [ (cid,d) | d@(C.LincatDef cid _) <- lincats ]
+
+        funMap :: Map.Map C.FunId C.FunDef
+        funMap = Map.fromList [ (fid,d) | d@(C.FunDef fid _) <- funs ]
+
+        -- | Lookup paramdef, providing dummy fallback when not found
+        -- Workaround for https://github.com/GrammaticalFramework/gf-core/issues/100
+        lookupParamDef :: C.ParamId -> Either String C.ParamDef
+        lookupParamDef pid = case Map.lookup pid paramValueMap of
+          Just d -> Right d
+          Nothing ->
+            -- Left $ printf "Cannot find param definition: %s" (show pid)
+            Right $ C.ParamDef (C.ParamId (C.Unqual "DUMMY")) [C.Param pid []]
+
+        -- | Lookup lintype for a function
+        lookupLinType :: C.FunId -> Either String C.LinType
+        lookupLinType funId = do
+          fun <- m2e (printf "Cannot find type for: %s" (show funId)) (Map.lookup funId funMap)
+          let (C.FunDef _ (C.Type _ (C.TypeApp catId _))) = fun
+          lincat <- m2e (printf "Cannot find lincat for: %s" (show catId)) (Map.lookup catId lincatMap)
+          let (C.LincatDef _ lt) = lincat
+          return lt
+
+        -- | Lookup lintype for a function's argument
+        lookupLinTypeArg :: C.FunId -> Int -> Either String C.LinType
+        lookupLinTypeArg funId argIx = do
+          fun <- m2e (printf "Cannot find type for: %s" (show funId)) (Map.lookup funId funMap)
+          let (C.FunDef _ (C.Type args _)) = fun
+          let (C.TypeBinding _ (C.Type _ (C.TypeApp catId _))) = args !! argIx
+          lincat <- m2e (printf "Cannot find lincat for: %s" (show catId)) (Map.lookup catId lincatMap)
+          let (C.LincatDef _ lt) = lincat
+          return lt
+
+        -- Filter out record fields from definitions which don't appear in lincat.
+        -- Workaround for https://github.com/GrammaticalFramework/gf-core/issues/101
+        cleanupRecordFields :: C.LinValue -> C.LinType -> C.LinValue
+        cleanupRecordFields (C.RecordValue rrvs) (C.RecordType rrs) =
+          let defnFields = Map.fromList [ (lid, lt) | (C.RecordRow lid lt) <- rrs ]
+          in C.RecordValue
+              [ C.RecordRow lid lv'
+              | C.RecordRow lid lv <- rrvs
+              , Map.member lid defnFields
+              , let Just lt = Map.lookup lid defnFields
+              , let lv' = cleanupRecordFields lv lt
+              ]
+        cleanupRecordFields lv _ = lv
+
+        lindefs' =
+          [ C.LinDef funId varIds linValue'
+          | (C.LinDef funId varIds linValue) <- lindefs
+          , let Right linType = lookupLinType funId
+          , let linValue' = cleanupRecordFields linValue linType
+          ]
+        es = map mkLin lindefs'
+        lins = Map.fromList $ rights es
+
+        -- | Main code generation function
+        mkLin :: C.LinDef -> Either String (CId, L.LinFun)
+        mkLin (C.LinDef funId varIds linValue) = do
+          -- when debug $ trace funId
+          (lf, _) <- val2lin linValue
+          return (fi2i funId, lf)
+          where
+            val2lin :: C.LinValue -> Either String (L.LinFun, Maybe C.LinType)
+            val2lin lv = case lv of
+
+              C.ConcatValue v1 v2 -> do
+                (v1',t1) <- val2lin v1
+                (v2',t2) <- val2lin v2
+                return (L.Concat v1' v2', t1 <|> t2) -- t1 else t2
+
+              C.LiteralValue ll -> case ll of
+                C.FloatConstant f -> return (L.Token $ show f, Just C.FloatType)
+                C.IntConstant i -> return (L.Token $ show i, Just C.IntType)
+                C.StrConstant s -> return (L.Token s, Just C.StrType)
+
+              C.ErrorValue err -> return (L.Error err, Nothing)
+
+              C.ParamConstant (C.Param pid lvs) -> do
+                let
+                  collectProjections :: C.LinValue -> Either String [L.LinFun]
+                  collectProjections (C.ParamConstant (C.Param pid lvs)) = do
+                    def <- lookupParamDef pid
+                    let (C.ParamDef tpid defpids) = def
+                    pidIx <- eitherElemIndex pid [ p | C.Param p _ <- defpids ]
+                    rest <- mapM collectProjections lvs
+                    return $ L.Ix (pidIx+1) : concat rest
+                  collectProjections lv = do
+                    (lf,_) <- val2lin lv
+                    return [lf]
+                lfs <- collectProjections lv
+                let term = L.Tuple lfs
+                def <- lookupParamDef pid
+                let (C.ParamDef tpid _) = def
+                return (term, Just $ C.ParamType (C.ParamTypeId tpid))
+
+              C.PredefValue (C.PredefId pid) -> case pid of
+                "BIND" -> return (L.Bind, Nothing)
+                "SOFT_BIND" -> return (L.Bind, Nothing)
+                "SOFT_SPACE" -> return (L.Space, Nothing)
+                "CAPIT" -> return (L.Capit, Nothing)
+                "ALL_CAPIT" -> return (L.AllCapit, Nothing)
+                _ -> Left $ printf "Unknown predef function: %s" pid
+
+              C.RecordValue rrvs -> do
+                let rrvs' = sortRecordRows rrvs
+                ts <- sequence [ val2lin lv | C.RecordRow lid lv <- rrvs' ]
+                return (L.Tuple (map fst ts), Just $ C.RecordType [ C.RecordRow lid lt | (C.RecordRow lid _, (_, Just lt)) <- zip rrvs' ts])
+
+              C.TableValue lt trvs -> do
+                -- group the rows by "left-most" value
+                let
+                  groupRow :: C.TableRowValue -> C.TableRowValue -> Bool
+                  groupRow (C.TableRow p1 _) (C.TableRow p2 _) = groupPattern p1 p2
+
+                  groupPattern :: C.LinPattern -> C.LinPattern -> Bool
+                  groupPattern p1 p2 = case (p1,p2) of
+                    (C.ParamPattern (C.Param pid1 _), C.ParamPattern (C.Param pid2 _)) -> pid1 == pid2 -- compare only constructors
+                    (C.RecordPattern (C.RecordRow lid1 patt1:_), C.RecordPattern (C.RecordRow lid2 patt2:_)) -> groupPattern patt1 patt2 -- lid1 == lid2 necessarily
+                    _ -> error $ printf "Mismatched patterns in grouping:\n%s\n%s" (show p1) (show p2)
+
+                  grps :: [[C.TableRowValue]]
+                  grps = L.groupBy groupRow trvs
+
+                -- remove one level of depth and recurse
+                let
+                  handleGroup :: [C.TableRowValue] -> Either String (L.LinFun, Maybe C.LinType)
+                  handleGroup [C.TableRow patt lv] =
+                    case reducePattern patt of
+                      Just patt' -> do
+                        (lf,lt) <- handleGroup [C.TableRow patt' lv]
+                        return (L.Tuple [lf],lt)
+                      Nothing    -> val2lin lv
+                  handleGroup rows = do
+                    let rows' = map reduceRow rows
+                    val2lin (C.TableValue lt rows') -- lt is wrong here, but is unused
+
+                  reducePattern :: C.LinPattern -> Maybe C.LinPattern
+                  reducePattern patt =
+                    case patt of
+                      C.ParamPattern (C.Param _ []) -> Nothing
+                      C.ParamPattern (C.Param _ patts) -> Just $ C.ParamPattern (C.Param pid' patts')
+                        where
+                          C.ParamPattern (C.Param pid1 patts1) = head patts
+                          pid' = pid1
+                          patts' = patts1 ++ tail patts
+
+                      C.RecordPattern [] -> Nothing
+                      C.RecordPattern (C.RecordRow lid patt:rrs) ->
+                        case reducePattern patt of
+                          Just patt' -> Just $ C.RecordPattern (C.RecordRow lid patt':rrs)
+                          Nothing    -> if null rrs then Nothing else Just $ C.RecordPattern rrs
+
+                      _ -> error $ printf "Unhandled pattern in reducing: %s" (show patt)
+
+                  reduceRow :: C.TableRowValue -> C.TableRowValue
+                  reduceRow (C.TableRow patt lv) =
+                    let Just patt' = reducePattern patt
+                    in  C.TableRow patt' lv
+
+                -- ts :: [(L.LinFun, Maybe C.LinType)]
+                ts <- mapM handleGroup grps
+
+                -- return
+                let typ = case ts of
+                      (_, Just tst):_ -> Just $ C.TableType lt tst
+                      _ -> Nothing
+                return (L.Tuple (map fst ts), typ)
+
+              -- TODO TuplePattern, WildPattern?
+
+              C.TupleValue lvs -> do
+                ts <- mapM val2lin lvs
+                return (L.Tuple (map fst ts), Just $ C.TupleType (map (fromJust.snd) ts))
+
+              C.VariantValue [] -> return (L.Empty, Nothing) -- TODO Just C.StrType ?
+              C.VariantValue (vr:_) -> val2lin vr -- NOTE variants not supported, just pick first
+
+              C.VarValue (C.VarValueId (C.Unqual v)) -> do
+                ix <- eitherElemIndex (C.VarId v) varIds
+                lt <- lookupLinTypeArg funId ix
+                return (L.Argument (ix+1), Just lt)
+
+              C.PreValue pts df -> do
+                pts' <- forM pts $ \(pfxs, lv) -> do
+                  (lv', _) <- val2lin lv
+                  return (pfxs, lv')
+                (df', lt) <- val2lin df
+                return (L.Pre pts' df', lt)
+
+              C.Projection v1 lblId -> do
+                (v1', mtyp) <- val2lin v1
+                -- find label index in argument type
+                let Just (C.RecordType rrs) = mtyp
+                let rrs' = [ lid | C.RecordRow lid _ <- rrs ]
+                -- lblIx <- eitherElemIndex lblId rrs'
+                let
+                  lblIx = case eitherElemIndex lblId rrs' of
+                    Right x -> x
+                    Left _ -> 0 -- corresponds to Prelude.False
+                -- lookup lintype for record row
+                let C.RecordRow _ lt = rrs !! lblIx
+                return (L.Projection v1' (L.Ix (lblIx+1)), Just lt)
+
+              C.Selection v1 v2 -> do
+                (v1', t1) <- val2lin v1
+                (v2', t2) <- val2lin v2
+                let Just (C.TableType t11 t12) = t1 -- t11 == t2
+                return (L.Projection v1' v2', Just t12)
+
+              -- C.CommentedValue cmnt lv -> val2lin lv
+              C.CommentedValue cmnt lv -> case cmnt of
+                "impossible" -> val2lin lv >>= \(_, typ) -> return (L.Empty, typ)
+                _ -> val2lin lv
+
+              v -> Left $ printf "val2lin not implemented for: %s" (show v)
+
+      unless (null $ lefts es) (raise $ unlines (lefts es))
+
+      let maybeOptimise = if debug then id else extractStrings
+      let concr = maybeOptimise $ L.Concrete {
+        L.toks = IntMap.empty,
+        L.lins = lins
+      }
+      return (mdi2i modId, concr)
+
+-- | Remove ParamAliasDefs by inlining their definitions
+inlineParamAliases :: [C.ParamDef] -> [C.ParamDef]
+inlineParamAliases defs = if null aliases then defs else map rp' pdefs
+  where
+    (aliases,pdefs) = L.partition isParamAliasDef defs
+
+    rp' :: C.ParamDef -> C.ParamDef
+    rp' (C.ParamDef pid pids) = C.ParamDef pid (map rp'' pids)
+    rp' (C.ParamAliasDef _ _) = error "inlineParamAliases called on ParamAliasDef" -- impossible
+
+    rp'' :: C.ParamValueDef -> C.ParamValueDef
+    rp'' (C.Param pid pids) = C.Param pid (map rp''' pids)
+
+    rp''' :: C.ParamId -> C.ParamId
+    rp''' pid = case L.find (\(C.ParamAliasDef p _) -> p == pid) aliases of
+      Just (C.ParamAliasDef _ (C.ParamType (C.ParamTypeId p))) -> p
+      _ -> pid
+
+-- | Always put 's' reocord field first, then sort alphabetically.
+-- Workaround for https://github.com/GrammaticalFramework/gf-core/issues/102
+-- Based on GF.Granmar.Macros.sortRec
+sortRecordRows :: [C.RecordRowValue] -> [C.RecordRowValue]
+sortRecordRows = L.sortBy ordLabel
+  where
+    ordLabel (C.RecordRow (C.LabelId l1) _) (C.RecordRow (C.LabelId l2) _) =
+      case (l1,l2) of
+        ("s",_) -> LT
+        (_,"s") -> GT
+        (s1,s2) -> compare s1 s2
+
+-- sortRecord :: C.LinValue -> C.LinValue
+-- sortRecord (C.RecordValue rrvs) = C.RecordValue (sortRecordRows rrvs)
+-- sortRecord lv = lv
+
+isParamAliasDef :: C.ParamDef -> Bool
+isParamAliasDef (C.ParamAliasDef _ _) = True
+isParamAliasDef _ = False
+
+isParamType :: C.LinType -> Bool
+isParamType (C.ParamType _) = True
+isParamType _ = False
+
+isRecordType :: C.LinType -> Bool
+isRecordType (C.RecordType _) = True
+isRecordType _ = False
+
+-- | Find all token strings, put them in a map and replace with token indexes
+extractStrings :: L.Concrete -> L.Concrete
+extractStrings concr = L.Concrete { L.toks = toks', L.lins = lins' }
+  where
+    imb = IntMapBuilder.fromIntMap (L.toks concr)
+    (lins',imb') = CMS.runState (go0 (L.lins concr)) imb
+    toks' = IntMapBuilder.toIntMap imb'
+
+    go0 :: Map.Map CId L.LinFun -> CMS.State (IntMapBuilder.IMB String) (Map.Map CId L.LinFun)
+    go0 mp = do
+      xs <- mapM (\(cid,lin) -> go lin >>= \lin' -> return (cid,lin')) (Map.toList mp)
+      return $ Map.fromList xs
+
+    go :: L.LinFun -> CMS.State (IntMapBuilder.IMB String) L.LinFun
+    go lf = case lf of
+      L.Token str -> do
+        imb <- CMS.get
+        let (ix,imb') = IntMapBuilder.insert' str imb
+        CMS.put imb'
+        return $ L.TokenIx ix
+
+      L.Pre pts df -> do
+        -- pts' <- mapM (\(pfxs,lv) -> go lv >>= \lv' -> return (pfxs,lv')) pts
+        pts' <- forM pts $ \(pfxs,lv) -> do
+          imb <- CMS.get
+          let str = show pfxs
+          let (ix,imb') = IntMapBuilder.insert' str imb
+          CMS.put imb'
+          lv' <- go lv
+          return (ix,lv')
+        df' <- go df
+        return $ L.PreIx pts' df'
+      L.Concat s t -> do
+        s' <- go s
+        t' <- go t
+        return $ L.Concat s' t'
+      L.Tuple ts -> do
+        ts' <- mapM go ts
+        return $ L.Tuple ts'
+      L.Projection t u -> do
+        t' <- go t
+        u' <- go u
+        return $ L.Projection t' u'
+      t -> return t
+
+-- | Convert Maybe to Either value with error
+m2e :: String -> Maybe a -> Either String a
+m2e err = maybe (Left err) Right
+
+-- | Wrap elemIndex into Either value
+eitherElemIndex :: (Eq a, Show a) => a -> [a] -> Either String Int
+eitherElemIndex x xs = m2e (printf "Cannot find: %s in %s" (show x) (show xs)) (elemIndex x xs)
+
+mdi2s :: C.ModId -> String
+mdi2s (C.ModId i) = i
+
+mdi2i :: C.ModId -> CId
+mdi2i (C.ModId i) = mkCId i
+
+fi2i :: C.FunId -> CId
+fi2i (C.FunId i) = mkCId i
+
+-- Debugging
+
+debugDir :: FilePath
+debugDir = "DEBUG"
+
+-- | Pretty-print canonical grammars to file
+ppCanonical :: FilePath -> C.Grammar -> IO ()
+ppCanonical path (C.Grammar ab cncs) = do
+  let (C.Abstract modId flags cats funs) = ab
+  writeFile (path </> mdi2s modId <.> "canonical.gf") (render $ pp ab)
+  forM_ cncs $ \cnc@(C.Concrete modId absModId flags params lincats lindefs) ->
+    writeFile' (path </> mdi2s modId <.> "canonical.gf") (render $ pp cnc)
+
+-- | Dump canonical grammars to file
+dumpCanonical :: FilePath -> C.Grammar -> IO ()
+dumpCanonical path (C.Grammar ab cncs) = do
+  let (C.Abstract modId flags cats funs) = ab
+  let body = unlines $ map show cats ++ [""] ++ map show funs
+  writeFile' (path </> mdi2s modId <.> "canonical.dump") body
+
+  forM_ cncs $ \(C.Concrete modId absModId flags params lincats lindefs) -> do
+    let body = unlines $ concat [
+          map show params,
+          [""],
+          map show lincats,
+          [""],
+          map show lindefs
+          ]
+    writeFile' (path </> mdi2s modId <.> "canonical.dump") body
+
+-- | Pretty-print LPGF to file
+ppLPGF :: FilePath -> LPGF -> IO ()
+ppLPGF path lpgf =
+  forM_ (Map.toList $ L.concretes lpgf) $ \(cid,concr) ->
+    writeFile' (path </> showCId cid <.> "lpgf.txt") (L.render $ L.pp concr)
+
+-- | Dump LPGF to file
+dumpLPGF :: FilePath -> LPGF -> IO ()
+dumpLPGF path lpgf =
+  forM_ (Map.toList $ L.concretes lpgf) $ \(cid,concr) -> do
+    let body = unlines $ map show (Map.toList $ L.lins concr)
+    writeFile' (path </> showCId cid <.> "lpgf.dump") body
+
+-- | Write a file and report it to console
+writeFile' :: FilePath -> String -> IO ()
+writeFile' p b = do
+  writeFile p b
+  putStrLn $ "Wrote " ++ p

src/compiler/GF/Compiler.hs

@@ -1,9 +1,11 @@
-module GF.Compiler (mainGFC, linkGrammars, writePGF, writeOutputs) where
+module GF.Compiler (mainGFC, linkGrammars, writePGF, writeLPGF, writeOutputs) where
 
 import PGF
 import PGF.Internal(concretes,optimizePGF,unionPGF)
 import PGF.Internal(putSplitAbs,encodeFile,runPut)
-import GF.Compile as S(batchCompile,link,srcAbsName)
+import LPGF(LPGF)
+import qualified LPGF
+import GF.Compile as S(batchCompile,link,linkl,srcAbsName)
 import GF.CompileInParallel as P(parallelBatchCompile)
 import GF.Compile.Export
 import GF.Compile.ConcreteToHaskell(concretes2haskell)
@@ -11,7 +13,8 @@ import GF.Compile.GrammarToCanonical--(concretes2canonical)
 import GF.Compile.CFGtoPGF
 import GF.Compile.GetGrammar
 import GF.Grammar.BNFC
-import GF.Grammar.CFG
+import GF.Grammar.CFG hiding (Grammar)
+import GF.Grammar.Grammar (Grammar, ModuleName)
 
 --import GF.Infra.Ident(showIdent)
 import GF.Infra.UseIO
@@ -23,10 +26,11 @@ import GF.Text.Pretty(render,render80)
 import Data.Maybe
 import qualified Data.Map as Map
 import qualified Data.Set as Set
+import Data.Time(UTCTime)
 import qualified Data.ByteString.Lazy as BSL
 import GF.Grammar.CanonicalJSON (encodeJSON)
 import System.FilePath
-import Control.Monad(when,unless,forM_)
+import Control.Monad(when,unless,forM,void)
 
 -- | Compile the given GF grammar files. The result is a number of @.gfo@ files
 -- and, depending on the options, a @.pgf@ file. (@gf -batch@, @gf -make@)
@@ -93,6 +97,10 @@ compileSourceFiles opts fs =
 -- If a @.pgf@ file by the same name already exists and it is newer than the
 -- source grammar files (as indicated by the 'UTCTime' argument), it is not
 -- recreated. Calls 'writePGF' and 'writeOutputs'.
+linkGrammars :: Options -> (UTCTime,[(ModuleName, Grammar)]) -> IOE ()
+linkGrammars opts (_,cnc_grs) | FmtLPGF `elem` flag optOutputFormats opts = do
+  lpgf <- linkl opts (head cnc_grs)
+  void $ writeLPGF opts lpgf
 linkGrammars opts (t_src,~cnc_grs@(~(cnc,gr):_)) =
     do let abs = render (srcAbsName gr cnc)
            pgfFile = outputPath opts (grammarName' opts abs<.>"pgf")
@@ -145,7 +153,7 @@ unionPGFFiles opts fs =
              pgfFile = outputPath opts (grammarName opts pgf <.> "pgf")
          if pgfFile `elem` fs
            then putStrLnE $ "Refusing to overwrite " ++ pgfFile
-           else writePGF opts pgf
+           else void $ writePGF opts pgf
          writeOutputs opts pgf
 
     readPGFVerbose f =
@@ -162,26 +170,39 @@ writeOutputs opts pgf = do
 -- | Write the result of compiling a grammar (e.g. with 'compileToPGF' or
 -- 'link') to a @.pgf@ file.
 -- A split PGF file is output if the @-split-pgf@ option is used.
-writePGF :: Options -> PGF -> IOE ()
+writePGF :: Options -> PGF -> IOE [FilePath]
 writePGF opts pgf =
     if flag optSplitPGF opts then writeSplitPGF else writeNormalPGF
   where
     writeNormalPGF =
        do let outfile = outputPath opts (grammarName opts pgf <.> "pgf")
           writing opts outfile $ encodeFile outfile pgf
+          return [outfile]
 
     writeSplitPGF =
       do let outfile = outputPath opts (grammarName opts pgf <.> "pgf")
          writing opts outfile $ BSL.writeFile outfile (runPut (putSplitAbs pgf))
                                 --encodeFile_ outfile (putSplitAbs pgf)
-         forM_ (Map.toList (concretes pgf)) $ \cnc -> do
+         outfiles <- forM (Map.toList (concretes pgf)) $ \cnc -> do
            let outfile = outputPath opts (showCId (fst cnc) <.> "pgf_c")
            writing opts outfile $ encodeFile outfile cnc
+           return outfile
 
+         return (outfile:outfiles)
 
-writeOutput :: Options -> FilePath-> String -> IOE ()
-writeOutput opts file str = writing opts path $ writeUTF8File path str
-  where path = outputPath opts file
+writeLPGF :: Options -> LPGF -> IOE FilePath
+writeLPGF opts lpgf = do
+  let
+    grammarName = fromMaybe (showCId (LPGF.abstractName lpgf)) (flag optName opts)
+    outfile = outputPath opts (grammarName <.> "lpgf")
+  writing opts outfile $ liftIO $ LPGF.encodeFile outfile lpgf
+  return outfile
+
+writeOutput :: Options -> FilePath-> String -> IOE FilePath
+writeOutput opts file str = do
+  let outfile = outputPath opts file
+  writing opts outfile $ writeUTF8File outfile str
+  return outfile
 
 -- * Useful helper functions
 

src/compiler/GF/Data/IntMapBuilder.hs

@@ -0,0 +1,57 @@
+-- | In order to build an IntMap in one pass, we need a map data structure with
+-- fast lookup in both keys and values.
+-- This is achieved by keeping a separate reversed map of values to keys during building.
+module GF.Data.IntMapBuilder where
+
+import Data.IntMap (IntMap)
+import qualified Data.IntMap as IntMap
+import Data.Hashable (Hashable)
+import Data.HashMap.Strict (HashMap)
+import qualified Data.HashMap.Strict as HashMap
+import Data.Tuple (swap)
+import Prelude hiding (lookup)
+
+data IMB a = IMB {
+  intMap :: IntMap a,
+  valMap :: HashMap a Int
+}
+
+-- | An empty IMB
+empty :: (Eq a, Hashable a) => IMB a
+empty = IMB {
+  intMap = IntMap.empty,
+  valMap = HashMap.empty
+}
+
+-- | Lookup a value
+lookup :: (Eq a, Hashable a) => a -> IMB a -> Maybe Int
+lookup a IMB { valMap = vm } = HashMap.lookup a vm
+
+-- | Insert without any lookup
+insert :: (Eq a, Hashable a) => a -> IMB a -> (Int, IMB a)
+insert a IMB { intMap = im, valMap = vm } =
+  let
+    ix = IntMap.size im
+    im' = IntMap.insert ix a im
+    vm' = HashMap.insert a ix vm
+    imb' = IMB { intMap = im', valMap = vm' }
+  in
+    (ix, imb')
+
+-- | Insert only when lookup fails
+insert' :: (Eq a, Hashable a) => a -> IMB a -> (Int, IMB a)
+insert' a imb =
+  case lookup a imb of
+    Just ix -> (ix, imb)
+    Nothing -> insert a imb
+
+-- | Build IMB from existing IntMap
+fromIntMap :: (Eq a, Hashable a) => IntMap a -> IMB a
+fromIntMap im = IMB {
+  intMap = im,
+  valMap = HashMap.fromList (map swap (IntMap.toList im))
+}
+
+-- | Get IntMap from IMB
+toIntMap :: (Eq a, Hashable a) => IMB a -> IntMap a
+toIntMap = intMap

src/compiler/GF/Grammar/Canonical.hs

@@ -30,7 +30,7 @@ data TypeApp  = TypeApp CatId [Type]        deriving Show
 data TypeBinding = TypeBinding VarId Type   deriving Show
 
 --------------------------------------------------------------------------------
--- ** Concreate syntax
+-- ** Concrete syntax
 
 -- | Concrete Syntax
 data Concrete  = Concrete ModId ModId Flags [ParamDef] [LincatDef] [LinDef]
@@ -104,7 +104,7 @@ data TableRow  rhs = TableRow  LinPattern rhs
 
 newtype PredefId   = PredefId Id        deriving (Eq,Ord,Show)
 newtype LabelId    = LabelId Id         deriving (Eq,Ord,Show)
-data VarValueId  = VarValueId QualId  deriving (Eq,Ord,Show)
+newtype VarValueId = VarValueId QualId  deriving (Eq,Ord,Show)
 
 -- | Name of param type or param value
 newtype ParamId = ParamId QualId  deriving (Eq,Ord,Show)
@@ -115,9 +115,9 @@ newtype ParamId = ParamId QualId  deriving (Eq,Ord,Show)
 newtype ModId = ModId Id  deriving (Eq,Ord,Show)
 
 newtype CatId = CatId Id  deriving (Eq,Ord,Show)
-newtype FunId = FunId Id  deriving (Eq,Show)
+newtype FunId = FunId Id  deriving (Eq,Ord,Show)
 
-data VarId = Anonymous | VarId Id  deriving Show
+data VarId = Anonymous | VarId Id  deriving (Eq,Show)
 
 newtype Flags = Flags [(FlagName,FlagValue)] deriving Show
 type FlagName = Id

src/compiler/GF/Infra/Option.hs

@@ -87,7 +87,8 @@ data Verbosity = Quiet | Normal | Verbose | Debug
 data Phase = Preproc | Convert | Compile | Link
   deriving (Show,Eq,Ord)
 
-data OutputFormat = FmtPGFPretty
+data OutputFormat = FmtLPGF
+                  | FmtPGFPretty
                   | FmtCanonicalGF
                   | FmtCanonicalJson
                   | FmtJavaScript
@@ -330,7 +331,7 @@ optDescr =
      Option ['f'] ["output-format"] (ReqArg outFmt "FMT")
         (unlines ["Output format. FMT can be one of:",
                   "Canonical GF grammar: canonical_gf, canonical_json, (and haskell with option --haskell=concrete)",
-                  "Multiple concrete: pgf (default), json, js, pgf_pretty, prolog, python, ...", -- gar,
+                  "Multiple concrete: pgf (default), lpgf, json, js, pgf_pretty, prolog, python, ...", -- gar,
                   "Single concrete only: bnf, ebnf, fa, gsl, jsgf, regexp, slf, srgs_xml, srgs_abnf, vxml, ....", -- cf, lbnf,
                   "Abstract only: haskell, ..."]), -- prolog_abs,
      Option [] ["sisr"] (ReqArg sisrFmt "FMT")
@@ -472,7 +473,8 @@ outputFormats = map fst outputFormatsExpl
 
 outputFormatsExpl :: [((String,OutputFormat),String)]
 outputFormatsExpl =
-    [(("pgf_pretty",   FmtPGFPretty),"human-readable pgf"),
+    [(("lpgf",         FmtLPGF),"Linearisation-only PGF"),
+     (("pgf_pretty",   FmtPGFPretty),"Human-readable PGF"),
      (("canonical_gf", FmtCanonicalGF),"Canonical GF source files"),
      (("canonical_json", FmtCanonicalJson),"Canonical JSON source files"),
      (("js",           FmtJavaScript),"JavaScript (whole grammar)"),

src/runtime/haskell/LPGF.hs

@@ -0,0 +1,368 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+-- | Linearisation-only grammar format.
+-- Closely follows description in Section 2 of Angelov, Bringert, Ranta (2009):
+-- "PGF: A Portable Run-Time Format for Type-Theoretical Grammars".
+-- http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.640.6330&rep=rep1&type=pdf
+module LPGF where
+
+import PGF (Language)
+import PGF.CId
+import PGF.Expr (Expr)
+import PGF.Tree (Tree (..), expr2tree, prTree)
+
+import qualified Control.Exception as EX
+import Control.Monad (liftM, liftM2, forM_)
+import qualified Control.Monad.Writer as CMW
+import Data.Char (toUpper)
+import Data.Binary (Binary, put, get, putWord8, getWord8, encodeFile, decodeFile)
+import Data.Either (isLeft)
+import qualified Data.IntMap as IntMap
+import Data.List (isPrefixOf)
+import qualified Data.Map.Strict as Map
+import Text.Printf (printf)
+
+import Prelude hiding ((!!))
+import qualified Prelude
+
+-- | Linearisation-only PGF
+data LPGF = LPGF {
+  absname   :: CId,
+  abstract  :: Abstract,
+  concretes :: Map.Map CId Concrete
+} deriving (Show)
+
+-- | Abstract syntax (currently empty)
+data Abstract = Abstract {
+} deriving (Show)
+
+-- | Concrete syntax
+data Concrete = Concrete {
+  toks    :: IntMap.IntMap String, -- ^ all strings are stored exactly once here
+  -- lincats :: Map.Map CId LinType, -- ^ a linearization type for each category
+  lins    :: Map.Map CId LinFun  -- ^ a linearization function for each function
+} deriving (Show)
+
+-- | Abstract function type
+-- data Type = Type [CId] CId
+--   deriving (Show)
+
+-- -- | Linearisation type
+-- data LinType =
+--     StrType
+--   | IxType Int
+--   | ProductType [LinType]
+--   deriving (Show)
+
+-- | Linearisation function
+data LinFun =
+  -- Additions
+    Error String -- ^ a runtime error, should probably not be supported at all
+  | Bind -- ^ join adjacent tokens
+  | Space -- ^ space between adjacent tokens
+  | Capit -- ^ capitalise next character
+  | AllCapit -- ^ capitalise next word
+  | Pre [([String], LinFun)] LinFun
+  | Missing CId -- ^ missing definition (inserted at runtime)
+
+  -- From original definition in paper
+  | Empty
+  | Token String
+  | Concat LinFun LinFun
+  | Ix Int
+  | Tuple [LinFun]
+  | Projection LinFun LinFun
+  | Argument Int
+
+  -- For reducing LPGF file when stored
+  | PreIx [(Int, LinFun)] LinFun -- ^ index into `toks` map (must apply read to convert to list)
+  | TokenIx Int -- ^ index into `toks` map
+
+  deriving (Show, Read)
+
+instance Binary LPGF where
+  put lpgf = do
+    put (absname lpgf)
+    put (abstract lpgf)
+    put (concretes lpgf)
+  get = do
+    an <- get
+    abs <- get
+    concs <- get
+    return $ LPGF {
+      absname = an,
+      abstract = abs,
+      concretes = concs
+    }
+
+instance Binary Abstract where
+  put abs = return ()
+  get = return $ Abstract {}
+
+instance Binary Concrete where
+  put concr = do
+    put (toks concr)
+    put (lins concr)
+  get = do
+    ts <- get
+    ls <- get
+    return $ Concrete {
+      toks = ts,
+      lins = ls
+    }
+
+instance Binary LinFun where
+  put = \case
+    Error e          -> putWord8 0 >> put e
+    Bind             -> putWord8 1
+    Space            -> putWord8 2
+    Capit            -> putWord8 3
+    AllCapit         -> putWord8 4
+    Pre ps d         -> putWord8 5 >> put (ps,d)
+    Missing f        -> putWord8 13 >> put f
+
+    Empty            -> putWord8 6
+    Token t          -> putWord8 7 >> put t
+    Concat l1 l2     -> putWord8 8 >> put (l1,l2)
+    Ix i             -> putWord8 9 >> put i
+    Tuple ls         -> putWord8 10 >> put ls
+    Projection l1 l2 -> putWord8 11 >> put (l1,l2)
+    Argument i       -> putWord8 12 >> put i
+
+    PreIx ps d       -> putWord8 15 >> put (ps,d)
+    TokenIx i        -> putWord8 14 >> put i
+
+  get = do
+    tag <- getWord8
+    case tag of
+      0  -> liftM  Error get
+      1  -> return Bind
+      2  -> return Space
+      3  -> return Capit
+      4  -> return AllCapit
+      5  -> liftM2 Pre get get
+      13 -> liftM  Missing get
+
+      6  -> return Empty
+      7  -> liftM  Token get
+      8  -> liftM2 Concat get get
+      9  -> liftM  Ix get
+      10 -> liftM  Tuple get
+      11 -> liftM2 Projection get get
+      12 -> liftM  Argument get
+
+      15 -> liftM2 PreIx get get
+      14 -> liftM  TokenIx get
+      _  -> fail "Failed to decode LPGF binary format"
+
+abstractName :: LPGF -> CId
+abstractName = absname
+
+encodeFile :: FilePath -> LPGF -> IO ()
+encodeFile = Data.Binary.encodeFile
+
+readLPGF :: FilePath -> IO LPGF
+readLPGF = Data.Binary.decodeFile
+
+-- | Main linearize function, to 'String'
+linearize :: LPGF -> Language -> Expr -> String
+linearize lpgf lang =
+  case Map.lookup lang (concretes lpgf) of
+    Just concr -> linearizeConcrete concr
+    Nothing -> error $ printf "Unknown language: %s" (showCId lang)
+
+-- | Language-specific linearize function, to 'String'
+linearizeConcrete :: Concrete -> Expr -> String
+linearizeConcrete concr expr = lin2string $ lin (expr2tree expr)
+  where
+    lin :: Tree -> LinFun
+    lin tree = case tree of
+      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
+      x -> error $ printf "Cannot lin: %s" (prTree x)
+
+-- | Run a compatation and catch any exception/errors.
+-- Ideally this library should never throw exceptions, but we're still in development...
+try :: a -> IO (Either String a)
+try comp = do
+  let f = Right <$> EX.evaluate comp
+  EX.catch f (\(e :: EX.SomeException) -> return $ Left (show e))
+
+-- | Evaluation context
+data Context = Context {
+  cxArgs :: [LinFun], -- ^  is a sequence of terms
+  cxToks :: IntMap.IntMap String -- ^ token map
+}
+
+-- | Operational semantics
+eval :: Context -> LinFun -> LinFun
+eval cxt t = case t of
+  Error err -> error err
+  Pre pts df -> Pre pts' df'
+    where
+      pts' = [(pfxs, eval cxt t) | (pfxs, t) <- pts]
+      df' = eval cxt df
+
+  Concat s t -> Concat v w
+    where
+      v = eval cxt s
+      w = eval cxt t
+  Tuple ts -> Tuple vs
+    where vs = map (eval cxt) ts
+  Projection t u ->
+    case (eval cxt t, eval cxt u) of
+      (Missing f, _) -> Missing f
+      (_, Missing f) -> Missing f
+      (Tuple vs, Ix i) -> vs !! (i-1)
+      (t', tv@(Tuple _)) -> eval cxt $ foldl Projection t' (flattenTuple tv)
+      (t',u') -> error $ printf "Incompatible projection:\n- %s\n⇓ %s\n- %s\n⇓ %s" (show t) (show t') (show u) (show u')
+  Argument i -> cxArgs cxt !! (i-1)
+
+  PreIx pts df -> Pre pts' df'
+    where
+      pts' = [(pfxs, eval cxt t) | (ix, t) <- pts, let pfxs = maybe [] read $ IntMap.lookup ix (cxToks cxt)]
+      df' = eval cxt df
+  TokenIx i -> maybe Empty Token $ IntMap.lookup i (cxToks cxt)
+
+  _ -> t
+
+flattenTuple :: LinFun -> [LinFun]
+flattenTuple = \case
+  Tuple vs -> concatMap flattenTuple vs
+  lf -> [lf]
+
+-- | Turn concrete syntax terms into an actual string.
+-- This is done in two passes, first to flatten concats & evaluate pre's, then to
+-- apply BIND and other predefs.
+lin2string :: LinFun -> String
+lin2string lf = unwords $ join $ flatten [lf]
+  where
+    -- Process bind et al into final token list
+    join :: [Either LinFun String] -> [String]
+    join elt = case elt of
+      Right tok:Left Bind:ls ->
+        case join ls of
+          next:ls' -> tok : next : ls'
+          _ -> []
+      Right tok:ls -> tok : join ls
+      Left Space:ls -> join ls
+      Left Capit:ls ->
+        case join ls of
+          next:ls' -> (toUpper (head next) : tail next) : ls'
+          _ -> []
+      Left AllCapit:ls ->
+        case join ls of
+          next:ls' -> map toUpper next : ls'
+          _ -> []
+      Left (Missing cid):ls -> join (Right (printf "[%s]" (show cid)) : ls)
+      [] -> []
+      x -> error $ printf "Unhandled term in lin2string: %s" (show x)
+
+    -- Process concats, tuples, pre into flat list
+    flatten :: [LinFun] -> [Either LinFun String]
+    flatten [] = []
+    flatten (l:ls) = case l of
+      Empty -> flatten ls
+      Token "" -> flatten ls
+      Token tok -> Right tok : flatten ls
+      Concat l1 l2 -> flatten (l1 : l2 : ls)
+      Tuple [l] -> flatten (l:ls)
+      Tuple (l:_) -> flatten (l:ls) -- unselected table, just choose first option (see e.g. FoodsJpn)
+      Pre pts df ->
+        let
+          f = flatten ls
+          ch = case dropWhile isLeft f of
+            Right next:_ ->
+              let matches = [ l | (pfxs, l) <- pts, any (`isPrefixOf` next) pfxs ]
+              in  if null matches then df else head matches
+            _ -> df
+        in flatten (ch:ls)
+      x -> Left x : flatten ls
+
+-- | List indexing with more verbose error messages
+(!!) :: (Show a) => [a] -> Int -> a
+(!!) xs i
+  | i < 0 = error $ printf "!!: index %d too small for list: %s" i (show xs)
+  | i > length xs - 1 = error $ printf "!!: index %d too large for list: %s" i (show xs)
+  | otherwise = xs Prelude.!! i
+
+isIx :: LinFun -> Bool
+isIx (Ix _) = True
+isIx _ = False
+
+-- | Helper for building concat trees
+mkConcat :: [LinFun] -> LinFun
+mkConcat [] = Empty
+mkConcat [x] = x
+mkConcat xs = foldl1 Concat xs
+
+-- | Helper for unfolding concat trees
+unConcat :: LinFun -> [LinFun]
+unConcat (Concat l1 l2) = concatMap unConcat [l1, l2]
+unConcat lf = [lf]
+
+------------------------------------------------------------------------------
+-- Pretty-printing
+
+type Doc = CMW.Writer [String] ()
+
+render :: Doc -> String
+render = unlines . CMW.execWriter
+
+class PP a where
+  pp :: a -> Doc
+
+instance PP LPGF where
+  pp (LPGF _ _ cncs) = mapM_ pp cncs
+
+instance PP Concrete where
+  pp (Concrete toks lins) = do
+    forM_ (IntMap.toList toks) $ \(i,tok) ->
+      CMW.tell [show i ++ " " ++ tok]
+    CMW.tell [""]
+    forM_ (Map.toList lins) $ \(cid,lin) -> do
+      CMW.tell ["# " ++ showCId cid]
+      pp lin
+      CMW.tell [""]
+
+instance PP LinFun where
+  pp = pp' 0
+    where
+      pp' n = \case
+        Pre ps d -> do
+          p "Pre"
+          CMW.tell [ replicate (2*(n+1)) ' ' ++ show p | p <- ps ]
+          pp' (n+1) d
+
+        c@(Concat l1 l2) -> do
+          let ts = unConcat c
+          if any isDeep ts
+          then do
+            p "Concat"
+            mapM_ (pp' (n+1)) ts
+          else
+            p $ "Concat " ++ show ts
+        Tuple ls | any isDeep ls -> do
+          p "Tuple"
+          mapM_ (pp' (n+1)) ls
+        Projection l1 l2 | isDeep l1 || isDeep l2 -> do
+          p "Projection"
+          pp' (n+1) l1
+          pp' (n+1) l2
+        t -> p $ show t
+        where
+          p :: String -> Doc
+          p t = CMW.tell [ replicate (2*n) ' ' ++ t ]
+
+      isDeep = not . isTerm
+      isTerm = \case
+        Pre _ _ -> False
+        Concat _ _ -> False
+        Tuple _ -> False
+        Projection _ _ -> False
+        _ -> True

testsuite/lpgf/README.md

@@ -0,0 +1,239 @@
+# LPGF testsuite & benchmark
+
+## Test
+
+LPGF must be equivalent to PGF in terms of linearisation output.
+
+Possible exceptions:
+- No handling of variants (design choice)
+- Rendering of missing fucntions
+
+### Running
+
+```
+stack build --test --bench --no-run-tests --no-run-benchmarks
+stack test gf:test:lpgf # all LPGF tests
+stack test gf:test:lpgf --test-arguments="unittests/Params" # specific grammar
+stack test gf:test:lpgf --test-arguments="foods/Foods Fre Ger" # specific grammar and languages
+```
+
+```
+stack build --test --bench --no-run-tests --no-run-benchmarks && DEBUG=1 stack test gf:test:lpgf --test-arguments="foods/Foods Fre Ger"
+stack build --test --bench --no-run-tests --no-run-benchmarks && DEBUG=1 stack test gf:test:lpgf --test-arguments="phrasebook/Phrasebook Bul"
+```
+
+Set environment variable `DEBUG=1` to enable dumping of intermediate formats.
+
+## Benchmark
+
+Compare performance metrics between LPGF and PGF[2]. Note: correctness is not checked here.
+
+### Compilation
+
+Comparing PGF, LPGF along following criteria:
+
+- Time
+- Memory
+- Binary file size
+
+### Runtime (linearisation)
+
+Comparing PGF, PGF2, LPGF along following criteria:
+
+- Time
+- Memory
+
+### Running
+
+Run each command separately so that memory measurements are isolated.
+The `+RTS -T -RTS` is so that GHC can report its own memory usage.
+
+```
+stack build --test --bench --no-run-tests --no-run-benchmarks &&
+stack bench --benchmark-arguments "compile pgf  testsuite/lpgf/foods/Foods*.gf +RTS -T -RTS" &&
+stack bench --benchmark-arguments "compile lpgf testsuite/lpgf/foods/Foods*.gf +RTS -T -RTS" &&
+stack bench --benchmark-arguments "run pgf  Foods.pgf  testsuite/lpgf/foods/Foods-all.trees +RTS -T -RTS" &&
+stack bench --benchmark-arguments "run pgf2 Foods.pgf  testsuite/lpgf/foods/Foods-all.trees +RTS -T -RTS" &&
+stack bench --benchmark-arguments "run lpgf Foods.lpgf testsuite/lpgf/foods/Foods-all.trees +RTS -T -RTS"
+```
+
+```
+stack build --test --bench --no-run-tests --no-run-benchmarks &&
+stack bench --benchmark-arguments "compile pgf  testsuite/lpgf/phrasebook/Phrasebook*.gf +RTS -T -RTS" &&
+stack bench --benchmark-arguments "compile lpgf testsuite/lpgf/phrasebook/Phrasebook*.gf +RTS -T -RTS" &&
+stack bench --benchmark-arguments "run pgf  Phrasebook.pgf  testsuite/lpgf/phrasebook/Phrasebook-10000.trees +RTS -T -RTS" &&
+stack bench --benchmark-arguments "run pgf2 Phrasebook.pgf  testsuite/lpgf/phrasebook/Phrasebook-10000.trees +RTS -T -RTS" &&
+stack bench --benchmark-arguments "run lpgf Phrasebook.lpgf testsuite/lpgf/phrasebook/Phrasebook-10000.trees +RTS -T -RTS"
+```
+
+## Profiling
+
+```
+stack bench --work-dir .stack-work-profile --profile --benchmark-arguments "compile lpgf testsuite/lpgf/phrasebook/PhrasebookFre.gf +RTS -T -p -h -RTS"
+```
+
+Produced files:
+- `lpgf-bench.prof` - total time and memory allocation (`-p`)
+- `lpgf-bench.hp` - heap profile (`-h`)
+
+```
+stack exec -- hp2ps -c lpgf-bench.hp && open lpgf-bench.ps
+```
+
+**Resources**
+
+- https://downloads.haskell.org/ghc/8.6.5/docs/html/users_guide/profiling.html
+- http://book.realworldhaskell.org/read/profiling-and-optimization.html
+- https://wiki.haskell.org/Performance
+
+# Notes on compilation
+
+## 1 (see unittests/Params4)
+
+**param defns**
+P = P1 | P2
+Q = Q1 | Q2
+R = RP P | RPQ P Q | R0
+X = XPQ P Q
+
+**translation**
+NB: tuples may be nested, but will be concatted at runtime
+
+P1        = <1>
+P2        = <2>
+
+Q1        = <1>
+Q2        = <2>
+
+R P1      = <1,1>
+R P2      = <1,2>
+RPQ P1 Q1 = <2,1,1>
+RPQ P1 Q2 = <2,1,2>
+RPQ P2 Q1 = <2,2,1>
+RPQ P2 Q2 = <2,2,2>
+R0        = <3>
+
+XPQ P1 Q1 = <1,1,1>
+XPQ P1 Q2 = <1,1,2>
+XPQ P2 Q1 = <1,2,1>
+XPQ P2 Q2 = <1,2,2>
+
+P => Str
+<"P1","P2">
+
+{p:P ; q:Q} => Str
+<<"P1;Q1","P1;Q2">,<"P2;Q1","P2;Q2">>
+
+{p=P2; q=Q1}
+<<2>,<1>>
+
+R => Str
+< <"RP P1","RP P2">,
+  < <"RPQ P1 Q1","RPQ P1 Q2">,
+    <"RPQ P2 Q1","RPQ P2 Q2"> >,
+ "R0"
+>
+
+X => Str
+<<<"XPQ P1 Q1","XPQ P1 Q2">,
+  <"XPQ P2 Q1","XPQ P2 Q2">>>
+
+{p=P2 ; r=R0}
+<<2>,<3>>
+
+{p=P2 ; r1=RP P1 ; r2=RPQ P1 Q2 ; r3=R0 }
+< <2>  ,  <1, 1> ,   <2,  1, 2> ,   <3>>
+
+## 2 (see unittests/Params5)
+
+**param defns**
+
+P = P1 | PQ Q
+Q = Q1 | QR R
+R = R1 | R2
+
+**translation**
+
+P1       = <1>
+PQ Q1    = <2,1>
+PQ QR R1 = <2,2,1>
+PQ QR R2 = <2,2,2>
+
+Q1       = <1>
+QR R1    = <2,1>
+QR R2    = <2,2>
+
+R1       = <1>
+R2       = <2>
+
+P => Str
+<"P1",<"PQ Q1",<"PQ (QR R1)","PQ (QR R2)">>>
+
+{q:Q ; p:P} => Str
+< <"Q1;P1",<"Q1;PQ Q1",<"Q1;PQ (QR R1)","Q1;PQ (QR R2)">>>,
+  <
+    <"QR R1;P1",<"QR R1;PQ Q1",<"QR R1;PQ (QR R1)","QR R1;PQ (QR R2)">>>,
+    <"QR R2;P1",<"QR R2;PQ Q1",<"QR R2;PQ (QR R1)","QR R2;PQ (QR R2)">>>
+  >
+>
+
+{q=Q1 ; p=P1}            = <<1>,<1>>
+{q=Q1 ; p=PQ Q1}         = <<1>,<2,1>>
+{q=Q1 ; p=PQ (QR R1)}    = <<1>,<2,2,1>>
+{q=Q1 ; p=PQ (QR R2)}    = <<1>,<2,2,2>>
+
+{q=QR R1 ; p=P1}         = <<2,1>,<1>>
+{q=QR R1 ; p=PQ Q1}      = <<2,1>,<2,1>>
+{q=QR R1 ; p=PQ (QR R1)} = <<2,1>,<2,2,1>>
+{q=QR R1 ; p=PQ (QR R2)} = <<2,1>,<2,2,2>>
+
+{q=QR R2 ; p=P1}         = <<2,2>,<1>>
+{q=QR R2 ; p=PQ Q1}      = <<2,2>,<2,1>>
+{q=QR R2 ; p=PQ (QR R1)} = <<2,2>,<2,2,1>>
+{q=QR R2 ; p=PQ (QR R2)} = <<2,2>,<2,2,2>>
+
+**NOTE**: GF will swap q and p in record, as part of record field sorting, resulting in the following:
+
+{p:P ; q:Q} => Str
+< <"P1;Q1", <"P1;QR R1","P1;QR R2">>,
+  < <"PQ Q1;Q1", <"PQ Q1;QR R1","PQ Q1;QR R2">>,
+    < <"PQ (QR R1);Q1", <"PQ (QR R1);QR R1","PQ (QR R1);QR R2">>,
+      <"PQ (QR R2);Q1", <"PQ (QR R2);QR R1","PQ (QR R2);QR R2">>
+    >
+  >
+>
+
+{p=P1 ; q=Q1}            = <<1>,<1>>
+{p=P1 ; q=QR R1}         = <<1>,<2,1>>
+{p=P1 ; q=QR R2}         = <<1>,<2,2>>
+
+{p=PQ Q1 ; q=Q1}         = <<2,1>,<1>>
+{p=PQ Q1 ; q=QR R1}      = <<2,1>,<2,1>>
+{p=PQ Q1 ; q=QR R2}      = <<2,1>,<2,2>>
+
+{p=PQ (QR R1) ; q=Q1}    = <<2,2,1>,<1>>
+{p=PQ (QR R1) ; q=QR R1} = <<2,2,1>,<2,1>>
+{p=PQ (QR R1) ; q=QR R2} = <<2,2,1>,<2,2>>
+
+{p=PQ (QR R2) ; q=Q1}    = <<2,2,2>,<1>>
+{p=PQ (QR R2) ; q=QR R1} = <<2,2,2>,<2,1>>
+{p=PQ (QR R2) ; q=QR R2} = <<2,2,2>,<2,2>>
+
+
+{pp: {p:P} ; q:Q} => Str
+
+{pp={p=P1} ; q=Q1}            = <<<1>>,<1>>
+{pp={p=P1} ; q=QR R1}         = <<<1>>,<2,1>>
+{pp={p=P1} ; q=QR R2}         = <<<1>>,<2,2>>
+
+{pp={p=PQ Q1} ; q=Q1}         = <<<2,1>>, <1>>
+{pp={p=PQ Q1} ; q=QR R1}      = <<<2,1>>, <2,1>>
+{pp={p=PQ Q1} ; q=QR R2}      = <<<2,1>>, <2,2>>
+
+{pp={p=PQ (QR R1)} ; q=Q1}    = <<<2,2,1>>,<1>>
+{pp={p=PQ (QR R1)} ; q=QR R1} = <<<2,2,1>>,<2,1>>
+{pp={p=PQ (QR R1)} ; q=QR R2} = <<<2,2,1>>,<2,2>>
+
+{pp={p=PQ (QR R2)} ; q=Q1}    = <<<2,2,2>>,<1>>
+{pp={p=PQ (QR R2)} ; q=QR R1} = <<<2,2,2>>,<2,1>>
+{pp={p=PQ (QR R2)} ; q=QR R2} = <<<2,2,2>>,<2,2>>

testsuite/lpgf/bench.hs

@@ -0,0 +1,184 @@
+module Main where
+
+import qualified LPGF
+import qualified PGF
+import qualified PGF2
+
+import GF (compileToPGF, compileToLPGF, writePGF, writeLPGF)
+import GF.Support (Options, Flags (..), Verbosity (..), noOptions, addOptions, modifyFlags)
+
+import Control.DeepSeq (NFData, force)
+import Control.Exception (evaluate)
+import Control.Monad (when, forM)
+import Data.Either (isLeft)
+import qualified Data.List as L
+import Data.Maybe (fromJust, isJust, isNothing)
+import qualified Data.Map as Map
+import Data.Time.Clock (getCurrentTime, diffUTCTime)
+import System.Console.ANSI
+import System.Directory (listDirectory, getFileSize)
+import System.Environment (getArgs)
+import System.Exit (die)
+import System.FilePath ((</>), (<.>), takeFileName, takeDirectory, dropExtension)
+import Text.Printf (printf)
+
+import GHC.Stats
+
+options :: Options
+options = addOptions (modifyFlags (\f -> f{optVerbosity=Quiet})) noOptions
+
+usage :: String
+usage = "Arguments:\n\
+\  compile [pgf|lpgf] FoodsEng.gf FoodsGer.gf ...\n\
+\  run [pgf|pgf2|lpgf] Foods.pgf test.trees\
+\"
+
+main :: IO ()
+main = do
+  -- Parse command line arguments
+  args <- getArgs
+  let argc = length args
+  when (argc < 1) (die usage)
+  let (mode:_) = args
+  when (mode `L.notElem` ["compile","run"]) (die usage)
+  when (mode == "compile" && argc < 2) (die usage)
+  when (mode == "run" && argc < 3) (die usage)
+  let target = let a1 = args !! 1 in if a1 `elem` ["pgf", "pgf2", "lpgf"] then Just a1 else Nothing
+  let mods' = if mode == "compile" then drop (if isJust target then 2 else 1) args else []
+
+  mods <- concat <$> forM mods' (\mod ->
+    -- If * is supplied in module name, collect modules ourselves
+    if '*' `elem` mod
+    then do
+      let
+        dir = takeDirectory mod
+        pre = takeWhile (/='*') (takeFileName mod)
+        post = drop 1 $ dropWhile (/='*') (takeFileName mod)
+      map (dir </>)
+        . filter (\p -> let fn = takeFileName p in pre `L.isPrefixOf` fn && post `L.isSuffixOf` fn)
+        <$> listDirectory dir
+    else
+      return [mod]
+    )
+
+  let binaryFile = if mode == "run" then Just $ args !! (if isJust target then 2 else 1) else Nothing
+  let treesFile = if mode == "run" then Just $ args !! (if isJust target then 3 else 2) else Nothing
+
+  let doPGF = isNothing target || target == Just "pgf"
+  let doPGF2 = isNothing target || target == Just "pgf2"
+  let doLPGF = isNothing target || target == Just "lpgf"
+
+  -- Compilation
+  when (mode == "compile") $ do
+    when doPGF $ do
+      heading "PGF"
+      (path, pgf) <- time "- compile: " (compilePGF mods)
+      size <- getFileSize path
+      printf "- size: %s  %s\n" (convertSize size) path
+
+    when doLPGF $ do
+      heading "LPGF"
+      (path, lpgf) <- time "- compile: " (compileLPGF mods)
+      size <- getFileSize path
+      printf "- size: %s  %s\n" (convertSize size) path
+
+  -- Linearisation
+  when (mode == "run") $ do
+    -- Read trees
+    lns <- lines <$> readFile (fromJust treesFile)
+    let trees = map (fromJust . PGF.readExpr) lns
+    let trees2 = map (fromJust . PGF2.readExpr) lns
+    printf "Read %d trees\n" (length trees)
+
+    when doPGF $ do
+      heading "PGF"
+      pgf <- PGF.readPGF (dropExtension (fromJust binaryFile) <.> "pgf")
+      timePure "- linearise: " (linPGF pgf trees)
+      return ()
+
+    when doPGF2 $ do
+      heading "PGF2"
+      pgf <- PGF2.readPGF (dropExtension (fromJust binaryFile) <.> "pgf")
+      timePure "- linearise: " (linPGF2 pgf trees2)
+      return ()
+
+    when doLPGF $ do
+      heading "LPGF"
+      lpgf <- LPGF.readLPGF (dropExtension (fromJust binaryFile) <.> "lpgf")
+      -- timePure "- linearise: " (linLPGF lpgf trees)
+      ress <- time "- linearise: " (linLPGF' lpgf trees)
+      when (any (any isLeft) ress) $ do
+        setSGR [SetColor Foreground Dull Red]
+        putStrLn "Teminated with errors"
+        setSGR [Reset]
+
+  stats <- getRTSStats
+  printf "Max memory: %s\n" (convertSize (fromIntegral (max_mem_in_use_bytes stats)))
+
+heading :: String -> IO ()
+heading s = do
+  setSGR [SetColor Foreground Vivid Yellow, SetConsoleIntensity BoldIntensity]
+  putStrLn s
+  setSGR [Reset]
+
+-- For accurate timing, IO action must for evaluation itself (e.g., write to file)
+time :: String -> IO a -> IO a
+time desc io = do
+  start <- getCurrentTime
+  r <- io >>= evaluate -- only WHNF
+  end <- getCurrentTime
+  putStrLn $ desc ++ show (diffUTCTime end start)
+  return r
+
+-- Performs deep evaluation
+timePure :: (NFData a) => String -> a -> IO a
+timePure desc val = time desc (return $ force val)
+
+compilePGF :: [FilePath] -> IO (FilePath, PGF.PGF)
+compilePGF mods = do
+  pgf <- compileToPGF options mods
+  files <- writePGF options pgf
+  return (head files, pgf)
+
+compileLPGF :: [FilePath] -> IO (FilePath, LPGF.LPGF)
+compileLPGF mods = do
+  lpgf <- compileToLPGF options mods
+  file <- writeLPGF options lpgf
+  return (file, lpgf)
+
+linPGF :: PGF.PGF -> [PGF.Expr] -> [[String]]
+linPGF pgf trees =
+  [ map (PGF.linearize pgf lang) trees | lang <- PGF.languages pgf ]
+
+linPGF2 :: PGF2.PGF -> [PGF2.Expr] -> [[String]]
+linPGF2 pgf trees =
+  [ map (PGF2.linearize concr) trees | (_, concr) <- Map.toList (PGF2.languages pgf) ]
+
+linLPGF :: LPGF.LPGF -> [PGF.Expr] -> [[String]]
+linLPGF lpgf trees =
+  [ map (LPGF.linearizeConcrete concr) trees | (_,concr) <- Map.toList (LPGF.concretes lpgf) ]
+
+linLPGF' :: LPGF.LPGF -> [PGF.Expr] -> IO [[Either String String]]
+linLPGF' lpgf trees =
+  forM (Map.toList (LPGF.concretes lpgf)) $ \(_,concr) -> mapM (LPGF.try . LPGF.linearizeConcrete concr) trees
+
+-- | Produce human readable file size
+-- Adapted from https://hackage.haskell.org/package/hrfsize
+convertSize :: Integer -> String
+convertSize = convertSize'' . fromInteger
+
+convertSize' :: Double -> String
+convertSize' size
+  | size < 1024.0 = printf "%.0v bytes" size
+  | size < 1024.0 ^ (2 :: Int) = printf "%.2v KiB" $ size / 1024.0
+  | size < 1024.0 ^ (3 :: Int) = printf "%.2v MiB" $ size / 1024.0 ^ (2 :: Int)
+  | size < 1024.0 ^ (4 :: Int) = printf "%.2v GiB" $ size / 1024.0 ^ (3 :: Int)
+  | otherwise = printf "%.2v TiB" $ size / 1024.0 ^ (4 :: Int)
+
+convertSize'' :: Double -> String
+convertSize'' size
+  | size < 1000 = printf "%.0v bytes" size
+  | size < 1000 ^ (2 :: Int) = printf "%.2v KB" $ size / 1000
+  | size < 1000 ^ (3 :: Int) = printf "%.2v MB" $ size / 1000 ^ (2 :: Int)
+  | size < 1000 ^ (4 :: Int) = printf "%.2v GB" $ size / 1000 ^ (3 :: Int)
+  | otherwise = printf "%.2v TB" $ size / 1000 ^ (4 :: Int)

testsuite/lpgf/foods/CharactersGla.gf

@@ -0,0 +1,13 @@
+--# -coding=latin1
+resource CharactersGla = {
+	
+	--Character classes
+	oper
+		vowel : pattern Str = #("a"|"e"|"i"|"o"|"u"|"à"|"è"|"ì"|"ò"|"ù") ;
+		vowelCap : pattern Str = #("A"|"E"|"I"|"O"|"U"|"À"|"É"|"Ì"|"Ò"|"Ù") ;
+		consonant : pattern Str = #("b"|"c"|"d"|"f"|"g"|"h"|"j"|"k"|"l"|"m"|"n"|"p"|"q"|"r"|"s"|"t"|"v"|"w"|"x"|"z") ;
+		consonantCap : pattern Str = #("B"|"C"|"D"|"F"|"G"|"H"|"J"|"K"|"L"|"M"|"N"|"P"|"Q"|"R"|"S"|"T"|"V"|"W"|"X"|"Z") ;
+		broadVowel : pattern Str = #("a"|"o"|"u"|"à"|"ò"|"ù") ;
+		slenderVowel : pattern Str = #("e"|"i"|"è"|"ì") ;
+	
+}

testsuite/lpgf/foods/CharactersGle.gf

@@ -0,0 +1,13 @@
+--# -coding=latin1
+resource CharactersGle = {
+	
+	--Character classes
+	oper
+		vowel : pattern Str = #("a"|"e"|"i"|"o"|"u"|"á"|"é"|"í"|"ó"|"ú") ;
+		vowelCap : pattern Str = #("A"|"E"|"I"|"O"|"U"|"Á"|"É"|"Í"|"Ó"|"Ú") ;
+		consonant : pattern Str = #("b"|"c"|"d"|"f"|"g"|"h"|"j"|"k"|"l"|"m"|"n"|"p"|"q"|"r"|"s"|"t"|"v"|"w"|"x"|"z") ;
+		consonantCap : pattern Str = #("B"|"C"|"D"|"F"|"G"|"H"|"J"|"K"|"L"|"M"|"N"|"P"|"Q"|"R"|"S"|"T"|"V"|"W"|"X"|"Z") ;
+		broadVowel : pattern Str = #("a"|"o"|"u"|"á"|"ó"|"ú") ;
+		slenderVowel : pattern Str = #("e"|"i"|"é"|"í") ;
+	
+}

testsuite/lpgf/foods/Foods.gf

@@ -0,0 +1,15 @@
+-- (c) 2009 Aarne Ranta under LGPL
+
+abstract Foods = {
+  flags startcat = Comment ;
+  cat
+    Comment ; Item ; Kind ; Quality ;
+  fun
+    Pred : Item -> Quality -> Comment ;
+    This, That, These, Those : Kind -> Item ;
+    Mod : Quality -> Kind -> Kind ;
+    Wine, Cheese, Fish, Pizza : Kind ;
+    Very : Quality -> Quality ;
+    Fresh, Warm, Italian,
+      Expensive, Delicious, Boring : Quality ;
+}

testsuite/lpgf/foods/Foods.treebank

@@ -0,0 +1,185 @@
+Foods: Pred (That Wine) Delicious
+FoodsAfr: daardie wyn is heerlik
+FoodsAmh: ያ ወይን ጣፋጭ ነው::
+FoodsBul: онова вино е превъзходно
+FoodsCat: aquell vi és deliciós
+FoodsChi: 那 瓶 酒 是 美 味 的
+FoodsCze: tamto víno je vynikající
+FoodsDut: die wijn is lekker
+FoodsEng: that wine is delicious
+FoodsEpo: tiu vino estas bongusta
+FoodsFin: tuo viini on herkullinen
+FoodsFre: ce vin est délicieux
+FoodsGer: jener Wein ist köstlich
+FoodsGla: tha an fìon sin blasta
+FoodsGle: tá an fíon sin blasta
+FoodsHeb: היין ההוא טעים
+FoodsHin: वह मदिरा स्वादिष्ट है
+FoodsIce: þetta vín er ljúffengt
+FoodsIta: quel vino è delizioso
+FoodsJpn: その ワインは おいしい
+FoodsLat: id vinum est iucundum
+FoodsLav: tas vīns ir garšīgs
+FoodsMkd: она вино е вкусно
+FoodsMlt: dak l- inbid tajjeb
+FoodsMon: тэр дарс бол амттай
+FoodsNep: त्यो रक्सी स्वादिष्ट छ
+FoodsOri: ସେଇ ମଦ ସ୍ଵାଦିସ୍ଟ ଅଟେ
+FoodsPes: آن شراب لذىذ است
+FoodsPor: esse vinho é delicioso
+FoodsRon: acel vin este delicios
+FoodsSpa: ese vino es delicioso
+FoodsSwe: det där vinet är läckert
+FoodsTha: เหล้าองุ่น ขวด นั้น อร่อย
+FoodsTsn: bojalwa boo bo monate
+FoodsTur: şu şarap lezzetlidir
+FoodsUrd: وہ شراب مزیدار ہے
+
+Foods: Pred (This Pizza) (Very Boring)
+FoodsAfr: hierdie pizza is baie vervelig
+FoodsAmh: ይህ [Pizza] በጣም አስቀያሚ ነው::
+FoodsBul: тази пица е много еднообразна
+FoodsCat: aquesta pizza és molt aburrida
+FoodsChi: 这 张 比 萨 饼 是 非 常 难 吃 的
+FoodsCze: tato pizza je velmi nudná
+FoodsDut: deze pizza is erg saai
+FoodsEng: this pizza is very boring
+FoodsEpo: ĉi tiu pico estas tre enuiga
+FoodsFin: tämä pizza on erittäin tylsä
+FoodsFre: cette pizza est très ennuyeuse
+FoodsGer: diese Pizza ist sehr langweilig
+FoodsGla: tha an pizza seo glè leamh
+FoodsGle: tá an píotsa seo an-leamh
+FoodsHeb: הפיצה הזאת מאוד משעממת
+FoodsHin: यह पिज़्ज़ा अति अरुचिकर है
+FoodsIce: þessi flatbaka er mjög leiðinleg
+FoodsIta: questa pizza è molto noiosa
+FoodsJpn: この ピザは とても つまらない
+FoodsLat: haec placenta neapolitana est valde fluens
+FoodsLav: šī pica ir ļoti garlaicīga
+FoodsMkd: оваа пица е многу досадна
+FoodsMlt: din il- pizza tad-dwejjaq ħafna
+FoodsMon: энэ пицца бол маш амтгүй
+FoodsNep: यो पिज्जा धेरै नमिठा छ
+FoodsOri: ଏଇ ପିଜଜ଼ା ଅତି ଅରୁଚିକର ଅଟେ
+FoodsPes: این پیتزا خیلی ملال آور است
+FoodsPor: esta pizza é muito chata
+FoodsRon: această pizza este foarte plictisitoare
+FoodsSpa: esta pizza es muy aburrida
+FoodsSwe: den här pizzan är mycket tråkig
+FoodsTha: พิซซา ถาด นี้ น่าเบิ่อ มาก
+FoodsTsn: pizza e e bosula thata
+FoodsTur: bu pizza çok sıkıcıdır
+FoodsUrd: یھ پیزہ بہت فضول ہے
+
+Foods: Pred (This Cheese) Fresh
+FoodsAfr: hierdie kaas is vars
+FoodsAmh: ይህ አይብ አዲስ ነው::
+FoodsBul: това сирене е свежо
+FoodsCat: aquest formatge és fresc
+FoodsChi: 这 块 奶 酪 是 新 鲜 的
+FoodsCze: tento sýr je čerstvý
+FoodsDut: deze kaas is vers
+FoodsEng: this cheese is fresh
+FoodsEpo: ĉi tiu fromaĝo estas freŝa
+FoodsFin: tämä juusto on tuore
+FoodsFre: ce fromage est frais
+FoodsGer: dieser Käse ist frisch
+FoodsGla: tha an càise seo úr
+FoodsGle: tá an cháis seo úr
+FoodsHeb: הגבינה הזאת טריה
+FoodsHin: यह पनीर ताज़ा है
+FoodsIce: þessi ostur er ferskur
+FoodsIta: questo formaggio è fresco
+FoodsJpn: この チーズは 新鮮 だ
+FoodsLat: hoc formaticum est recens
+FoodsLav: šis siers ir svaigs
+FoodsMkd: ова сирење е свежо
+FoodsMlt: dan il- ġobon frisk
+FoodsMon: энэ бяслаг бол шинэ
+FoodsNep: यो चिज ताजा छ
+FoodsOri: ଏଇ ଛେନା ତାଜା ଅଟେ
+FoodsPes: این پنیر تازه است
+FoodsPor: este queijo é fresco
+FoodsRon: această brânză este proaspătă
+FoodsSpa: este queso es fresco
+FoodsSwe: den här osten är färsk
+FoodsTha: เนยแข็ง ก้อน นี้ สด
+FoodsTsn: kase e e ntsha
+FoodsTur: bu peynir tazedir
+FoodsUrd: یھ پنیر تازہ ہے
+
+Foods: Pred (Those Fish) Warm
+FoodsAfr: daardie visse is warm
+FoodsAmh: [Those] ትኩስ ነው::
+FoodsBul: онези риби са горещи
+FoodsCat: aquells peixos són calents
+FoodsChi: 那 几 条 鱼 是 温 热 的
+FoodsCze: tamty ryby jsou teplé
+FoodsDut: die vissen zijn warm
+FoodsEng: those fish are warm
+FoodsEpo: tiuj fiŝoj estas varmaj
+FoodsFin: nuo kalat ovat lämpimiä
+FoodsFre: ces poissons sont chauds
+FoodsGer: jene Fische sind warm
+FoodsGla: tha na h-èisg sin blàth
+FoodsGle: tá na héisc sin te
+FoodsHeb: הדגים ההם חמים
+FoodsHin: वे मछलीयँा गरम हैं
+FoodsIce: þessir fiskar eru heitir
+FoodsIta: quei pesci sono caldi
+FoodsJpn: その 魚は あたたかい
+FoodsLat: ei pisces sunt calidi
+FoodsLav: tās zivis ir siltas
+FoodsMkd: оние риби се топли
+FoodsMlt: dawk il- ħut sħan
+FoodsMon: тэдгээр загаснууд бол халуун
+FoodsNep: ती माछाहरु तातो छन्
+FoodsOri: ସେଇ ମାଛ ଗୁଡିକ ଗରମ ଅଟେ
+FoodsPes: آن ماهىها گرم هستند
+FoodsPor: esses peixes são quentes
+FoodsRon: acei peşti sunt calzi
+FoodsSpa: esos pescados son calientes
+FoodsSwe: de där fiskarna är varma
+FoodsTha: ปลา ตัว นั้น อุ่น
+FoodsTsn: dithlapi tseo di bothitho
+FoodsTur: şu balıklar ılıktır
+FoodsUrd: وہ مچھلیاں گرم ہیں
+
+Foods: Pred (That (Mod Boring (Mod Italian Pizza))) Expensive
+FoodsAfr: daardie vervelige Italiaanse pizza is duur
+FoodsAmh: ያ አስቀያሚ የጥልያን [Pizza] ውድ ነው::
+FoodsBul: онази еднообразна италианска пица е скъпа
+FoodsCat: aquella pizza italiana aburrida és cara
+FoodsChi: 那 张 又 难 吃 又 意 大 利 式 的 比 萨 饼 是 昂 贵 的
+FoodsCze: tamta nudná italská pizza je drahá
+FoodsDut: die saaie Italiaanse pizza is duur
+FoodsEng: that boring Italian pizza is expensive
+FoodsEpo: tiu enuiga itala pico estas altekosta
+FoodsFin: tuo tylsä italialainen pizza on kallis
+FoodsFre: cette pizza italienne ennuyeuse est chère
+FoodsGer: jene langweilige italienische Pizza ist teuer
+FoodsGla: tha an pizza Eadailteach leamh sin daor
+FoodsGle: tá an píotsa Iodálach leamh sin daor
+FoodsHeb: הפיצה האיטלקית המשעממת ההיא יקרה
+FoodsHin: वह अरुचिकर इटली पिज़्ज़ा बहुमूल्य है
+FoodsIce: þessi leiðinlega ítalska flatbaka er dýr
+FoodsIta: quella pizza italiana noiosa è cara
+FoodsJpn: その つまらない イタリアの ピザは たかい
+FoodsLat: ea placenta itala fluens neapolitana est pretiosa
+FoodsLav: tā garlaicīgā itāļu pica ir dārga
+FoodsMkd: онаа досадна италијанска пица е скапа
+FoodsMlt: dik il- pizza Taljana tad-dwejjaq għalja
+FoodsMon: тэр амтгүй итали пицца бол үнэтэй
+FoodsNep: त्यो नमिठा इटालियन पिज्जा महँगो छ
+FoodsOri: ସେଇ ଅରୁଚିକର ଇଟାଲି ପିଜଜ଼ା ମୁଲ୍ୟବାନ୍ ଅଟେ
+FoodsPes: آن پیتزا ایتالیایی ى ملال آور گران است
+FoodsPor: essa pizza Italiana chata é cara
+FoodsRon: acea pizza italiană plictisitoare este scumpă
+FoodsSpa: esa pizza italiana aburrida es cara
+FoodsSwe: den där tråkiga italienska pizzan är dyr
+FoodsTha: พิซซา อิตาลี น่าเบิ่อ ถาด นั้น แพง
+FoodsTsn: pizza eo ya ga Itali le e e bosula e a tura
+FoodsTur: şu sıkıcı İtalyan pizzası pahalıdır
+FoodsUrd: وہ فضول اٹا لوی پیزہ مہنگا ہے
+

testsuite/lpgf/foods/Foods.trees

@@ -0,0 +1,5 @@
+Pred (That Wine) Delicious
+Pred (This Pizza) (Very Boring)
+Pred (This Cheese) Fresh
+Pred (Those Fish) Warm
+Pred (That (Mod Boring (Mod Italian Pizza))) Expensive

testsuite/lpgf/foods/FoodsAfr.gf

@@ -0,0 +1,77 @@
+-- (c) 2009 Laurette Pretorius Sr & Jr and Ansu Berg under LGPL
+--# -coding=latin1
+
+concrete FoodsAfr of Foods = open Prelude, Predef in{
+	lincat
+		Comment = {s: Str} ;
+		Kind = {s: Number => Str} ;
+		Item = {s: Str ; n: Number} ;
+		Quality = {s: AdjAP => Str} ;
+		
+	lin	
+		Pred item quality = {s = item.s ++ "is" ++ (quality.s ! Predic)};
+		This kind = {s = "hierdie" ++ (kind.s ! Sg); n = Sg};
+		That kind = {s = "daardie" ++ (kind.s ! Sg); n = Sg};
+		These kind = {s = "hierdie" ++ (kind.s ! Pl); n = Pl};
+		Those kind = {s = "daardie" ++ (kind.s ! Pl); n = Pl};
+		Mod quality kind = {s = table{n => (quality.s ! Attr) ++ (kind.s!n)}};
+		
+		Wine = declNoun_e "wyn";
+		Cheese = declNoun_aa "kaas";
+		Fish = declNoun_ss "vis";
+		Pizza = declNoun_s "pizza";
+		
+		Very quality = veryAdj quality;
+		
+		Fresh = regAdj "vars";
+		Warm = regAdj "warm";
+		Italian = smartAdj_e "Italiaans";
+		Expensive = regAdj "duur";
+		Delicious = smartAdj_e "heerlik";
+		Boring = smartAdj_e "vervelig";
+		
+	param
+		AdjAP = Attr | Predic ;
+		Number = Sg | Pl ;
+	
+	oper
+		--Noun operations (wyn, kaas, vis, pizza)
+		
+		declNoun_aa: Str -> {s: Number => Str} = \x ->
+		let v = tk 2 x
+		in
+		{s = table{Sg => x ; Pl => v + (last x) +"e"}}; 
+		
+		declNoun_e: Str -> {s: Number => Str} = \x -> {s = table{Sg => x ; Pl => x + "e"}} ;
+		declNoun_s: Str -> {s: Number => Str} = \x -> {s = table{Sg => x ; Pl => x + "s"}} ;
+		
+		declNoun_ss: Str -> {s: Number => Str} = \x -> {s = table{Sg => x ; Pl => x + (last x) + "e"}} ;
+
+		
+		--Adjective operations
+		
+		mkAdj : Str -> Str -> {s: AdjAP => Str} = \x,y -> {s = table{Attr => x; Predic => y}};
+		
+		declAdj_e : Str -> {s : AdjAP=> Str} = \x -> mkAdj (x + "e") x;
+		declAdj_g : Str -> {s : AdjAP=> Str} = \w ->
+			let v = init w
+			in mkAdj (v + "ë") w ;
+		
+		declAdj_oog : Str -> {s : AdjAP=> Str} = \w ->
+			let v = init w
+			in 
+				let i = init v
+				in mkAdj (i + "ë") w ;
+					
+		regAdj : Str -> {s : AdjAP=> Str} = \x -> mkAdj x x;
+		
+		veryAdj : {s: AdjAP => Str} -> {s : AdjAP=> Str} =  \x -> {s = table{a => "baie" ++ (x.s!a)}};
+		
+		
+		smartAdj_e : Str -> {s : AdjAP=> Str} = \a -> case a of 
+		{
+			_ + "oog" 			   		=> declAdj_oog a ;
+			_ + ("e" | "ie" | "o" | "oe") + "g" 	=> declAdj_g a ;
+			_					   	=> declAdj_e a 
+		};
+}

testsuite/lpgf/foods/FoodsAmh.gf

@@ -0,0 +1,21 @@
+concrete FoodsAmh of Foods ={
+ flags coding = utf8;
+ lincat
+  Comment,Item,Kind,Quality = Str;
+ lin
+  Pred item quality = item ++ quality++ "ነው::" ;
+  This kind = "ይህ" ++ kind;
+  That kind = "ያ" ++ kind;
+  Mod quality kind = quality ++ kind;
+  Wine = "ወይን";
+  Cheese = "አይብ";
+  Fish = "ዓሳ";
+  Very quality = "በጣም" ++ quality;
+  Fresh = "አዲስ";
+  Warm = "ትኩስ";
+  Italian = "የጥልያን";
+  Expensive = "ውድ";
+  Delicious = "ጣፋጭ";
+  Boring = "አስቀያሚ";
+  
+}   

testsuite/lpgf/foods/FoodsBul.gf

@@ -0,0 +1,43 @@
+-- (c) 2009 Krasimir Angelov under LGPL
+
+concrete FoodsBul of Foods = {
+
+  flags
+    coding = utf8;
+
+  param
+    Gender = Masc | Fem | Neutr;
+    Number = Sg | Pl;
+    Agr    = ASg Gender | APl ;
+
+  lincat
+    Comment = Str ;
+    Quality = {s : Agr => Str} ;
+    Item = {s : Str; a : Agr} ;
+    Kind = {s : Number => Str; g : Gender} ;
+
+  lin
+    Pred item qual = item.s ++ case item.a of {ASg _ => "е"; APl => "са"} ++ qual.s ! item.a ;
+
+    This  kind = {s=case kind.g of {Masc=>"този"; Fem=>"тази";  Neutr=>"това" } ++ kind.s ! Sg; a=ASg kind.g} ;
+    That  kind = {s=case kind.g of {Masc=>"онзи"; Fem=>"онази"; Neutr=>"онова"} ++ kind.s ! Sg; a=ASg kind.g} ;
+    These kind = {s="тези"  ++ kind.s ! Pl; a=APl} ;
+    Those kind = {s="онези" ++ kind.s ! Pl; a=APl} ;
+
+    Mod qual kind = {s=\\n => qual.s ! (case n of {Sg => ASg kind.g; Pl => APl}) ++ kind.s ! n; g=kind.g} ;
+
+    Wine   = {s = table {Sg => "вино";   Pl => "вина"};   g = Neutr};
+    Cheese = {s = table {Sg => "сирене"; Pl => "сирена"}; g = Neutr};
+    Fish   = {s = table {Sg => "риба";   Pl => "риби"};   g = Fem};
+    Pizza  = {s = table {Sg => "пица";   Pl => "пици"};   g = Fem};
+
+    Very qual = {s = \\g => "много" ++ qual.s ! g};
+
+    Fresh     = {s = table {ASg Masc => "свеж";        ASg Fem => "свежа";       ASg Neutr => "свежо";       APl => "свежи"}};
+    Warm      = {s = table {ASg Masc => "горещ";       ASg Fem => "гореща";      ASg Neutr => "горещо";      APl => "горещи"}};
+    Italian   = {s = table {ASg Masc => "италиански";  ASg Fem => "италианска";  ASg Neutr => "италианско";  APl => "италиански"}};
+    Expensive = {s = table {ASg Masc => "скъп";        ASg Fem => "скъпа";       ASg Neutr => "скъпо";       APl => "скъпи"}};
+    Delicious = {s = table {ASg Masc => "превъзходен"; ASg Fem => "превъзходна"; ASg Neutr => "превъзходно"; APl => "превъзходни"}};
+    Boring    = {s = table {ASg Masc => "еднообразен"; ASg Fem => "еднообразна"; ASg Neutr => "еднообразно"; APl => "еднообразни"}};
+
+}

testsuite/lpgf/foods/FoodsCat.gf

@@ -0,0 +1,6 @@
+
+-- (c) 2009 Jordi Saludes under LGPL
+
+concrete FoodsCat of Foods = FoodsI with 
+  (Syntax = SyntaxCat),
+  (LexFoods = LexFoodsCat) ;

testsuite/lpgf/foods/FoodsChi.gf

@@ -0,0 +1,56 @@
+concrete FoodsChi of Foods = open Prelude in {
+flags coding = utf8 ;
+lincat
+    Comment, Item = Str;
+    Kind = knd ;
+    Quality = qual ;
+lin
+    Pred = (\itm, ql ->
+      case ql.hasVery of {
+        True  => itm ++ "是 非 常" ++ ql.s ++ ql.p ;
+        False => itm ++ "是"       ++ ql.s ++ ql.p } ) ;
+    This kind = "这" ++ kind.c ++ kind.m ++ kind.s ;
+    That kind = "那" ++ kind.c ++ kind.m ++ kind.s ;
+    These kind = "这" ++ "几" ++ kind.c ++ kind.m ++ kind.s ;
+    Those kind = "那" ++ "几" ++ kind.c ++ kind.m ++ kind.s ;
+    Mod = modifier ;
+
+    Wine  = geKind "酒" "瓶" ;
+    Pizza = geKind "比 萨 饼" "张" ;
+    Cheese  = geKind "奶 酪" "块";
+    Fish  = geKind "鱼" "条";
+
+    Very = (\q -> {s = q.s ; p = q.p ; hasVery = True}) ;
+    Fresh  = longQuality "新 鲜" ;
+    Warm  = longQuality "温 热" ;
+    Italian  = longQuality "意 大 利 式" ;
+    Expensive  = longQuality "昂 贵" ;
+    Delicious  = longQuality "美 味" ;
+     -- this technically translates to "unpalatable" instead of boring
+    Boring  = longQuality "难 吃" ;
+
+oper
+    -- lincat aliases
+    qual : Type = {s,p : Str ; hasVery : Bool} ;
+    knd  : Type = {s,c,m : Str; hasMod : Bool} ;
+
+    -- Constructor functions
+    mkKind : Str -> Str -> knd = \s,c ->
+      {s = s ; c = c; m = ""; hasMod = False} ;
+    geKind : Str -> Str -> knd = \s,cl ->
+      mkKind s (classifier cl) ;
+    longQuality : Str -> qual = \s ->
+      {s = s ; p = "的" ; hasVery = False}  ;
+    modifier : qual -> knd -> knd = \q,k ->
+      { s = k.s ; c = k.c ; m = modJoin k.hasMod q k.m ;
+        hasMod = True } ;
+
+    -- Helper functions
+    classifier : Str -> Str = \s ->
+      case s of {"" => "个" ; _  => s };
+    modJoin : Bool -> qual  -> Str -> Str = \bool, q,m ->
+      case bool of {
+        True  => "又" ++ q.s ++ "又" ++ m ;
+        False => q.s ++ q.p } ;
+
+}

testsuite/lpgf/foods/FoodsCze.gf

@@ -0,0 +1,35 @@
+-- (c) 2011 Katerina Bohmova under LGPL
+
+concrete FoodsCze of Foods = open ResCze in {
+  flags 
+    coding = utf8 ;
+  lincat
+    Comment = {s : Str} ; 
+    Quality = Adjective ; 
+    Kind = Noun ; 
+    Item = NounPhrase ;
+  lin
+    Pred item quality = 
+      {s = item.s ++ copula ! item.n ++ 
+           quality.s ! item.g ! item.n} ;
+    This  = det Sg "tento" "tato" "toto" ;
+    That  = det Sg "tamten" "tamta" "tamto" ;
+    These = det Pl "tyto" "tyto" "tato" ;
+    Those = det Pl "tamty" "tamty" "tamta" ;
+    Mod quality kind = {
+      s = \\n => quality.s ! kind.g ! n ++ kind.s ! n ;
+      g = kind.g
+      } ;
+    Wine = noun "víno" "vína" Neutr ;
+    Cheese = noun "sýr" "sýry" Masc ;
+    Fish = noun "ryba" "ryby" Fem ;
+    Pizza = noun "pizza" "pizzy" Fem ;
+    Very qual = {s = \\g,n => "velmi" ++ qual.s ! g ! n} ;
+    Fresh = regAdj "čerstv" ;
+    Warm = regAdj "tepl" ;
+    Italian = regAdj "italsk" ;
+    Expensive = regAdj "drah" ;
+    Delicious = regnfAdj "vynikající" ;
+    Boring = regAdj "nudn" ;
+}
+

testsuite/lpgf/foods/FoodsDut.gf

@@ -0,0 +1,58 @@
+-- (c) 2009 Femke Johansson under LGPL
+
+concrete FoodsDut of Foods = {
+
+	lincat
+		Comment = {s : Str};
+		Quality = {s : AForm => Str};
+		Kind = { s : Number => Str};
+		Item = {s : Str ; n : Number};
+	
+	lin
+		Pred item quality = 
+			{s = item.s ++ copula ! item.n ++ quality.s ! APred};
+		This = det Sg "deze";
+		These = det Pl "deze";
+		That = det Sg "die";
+		Those = det Pl "die";
+		
+		Mod quality kind =
+			{s = \\n => quality.s ! AAttr ++ kind.s ! n};
+			Wine = regNoun "wijn";
+			Cheese = noun "kaas" "kazen";
+			Fish = noun "vis" "vissen";
+			Pizza = noun "pizza" "pizza's";
+			
+			Very a = {s = \\f => "erg" ++ a.s ! f};
+			
+			Fresh = regadj "vers";
+			Warm = regadj "warm";
+			Italian = regadj "Italiaans";
+			Expensive = adj "duur" "dure";
+			Delicious = regadj "lekker";
+			Boring = regadj "saai";
+		
+		param
+			Number = Sg | Pl;
+			AForm = APred | AAttr;
+		
+		oper
+			det : Number -> Str ->
+				{s : Number => Str} -> {s : Str ; n: Number} =
+				\n,det,noun -> {s = det ++ noun.s ! n ; n=n};
+				
+			noun : Str -> Str -> {s : Number => Str} = 
+				\man,men -> {s = table {Sg => man; Pl => men}};
+				
+			regNoun : Str -> {s : Number => Str} =
+				\wijn -> noun wijn (wijn + "en");
+				
+			regadj : Str -> {s : AForm => Str} =
+				\koud -> adj koud (koud+"e");
+			
+			adj : Str -> Str -> {s : AForm => Str} =
+				\duur, dure -> {s = table {APred => duur; AAttr => dure}};
+				
+			copula : Number => Str =
+				table {Sg => "is" ; Pl => "zijn"};
+}

testsuite/lpgf/foods/FoodsEng.gf

@@ -0,0 +1,43 @@
+-- (c) 2009 Aarne Ranta under LGPL
+
+concrete FoodsEng of Foods = {
+  flags language = en_US;
+  lincat
+    Comment, Quality = {s : Str} ; 
+    Kind = {s : Number => Str} ; 
+    Item = {s : Str ; n : Number} ; 
+  lin
+    Pred item quality = 
+      {s = item.s ++ copula ! item.n ++ quality.s} ;
+    This  = det Sg "this" ;
+    That  = det Sg "that" ;
+    These = det Pl "these" ;
+    Those = det Pl "those" ;
+    Mod quality kind = 
+      {s = \\n => quality.s ++ kind.s ! n} ;
+    Wine = regNoun "wine" ;
+    Cheese = regNoun "cheese" ;
+    Fish = noun "fish" "fish" ;
+    Pizza = regNoun "pizza" ;
+    Very a = {s = "very" ++ a.s} ;
+    Fresh = adj "fresh" ;
+    Warm = adj "warm" ;
+    Italian = adj "Italian" ;
+    Expensive = adj "expensive" ;
+    Delicious = adj "delicious" ;
+    Boring = adj "boring" ;
+  param
+    Number = Sg | Pl ;
+  oper
+    det : Number -> Str -> 
+      {s : Number => Str} -> {s : Str ; n : Number} = 
+        \n,det,noun -> {s = det ++ noun.s ! n ; n = n} ;
+    noun : Str -> Str -> {s : Number => Str} = 
+      \man,men -> {s = table {Sg => man ; Pl => men}} ;
+    regNoun : Str -> {s : Number => Str} = 
+      \car -> noun car (car + "s") ;
+    adj : Str -> {s : Str} = 
+      \cold -> {s = cold} ;
+    copula : Number => Str = 
+      table {Sg => "is" ; Pl => "are"} ;
+}

testsuite/lpgf/foods/FoodsEpo.gf

@@ -0,0 +1,48 @@
+-- (c) 2009 Julia Hammar under LGPL
+
+concrete FoodsEpo of Foods = open Prelude in {
+
+  flags coding =utf8 ;
+
+  lincat
+    Comment = SS ; 
+    Kind, Quality = {s : Number => Str} ; 
+    Item = {s : Str ; n : Number} ; 
+
+  lin
+    Pred item quality = ss (item.s ++ copula ! item.n ++ quality.s ! item.n) ;
+    This = det Sg "ĉi tiu" ;
+    That  = det Sg "tiu" ;
+    These = det Pl "ĉi tiuj" ;
+    Those = det Pl "tiuj" ;
+    Mod quality kind = {s = \\n => quality.s ! n ++ kind.s ! n} ;
+    Wine = regNoun "vino" ;
+    Cheese = regNoun "fromaĝo" ;
+    Fish = regNoun "fiŝo" ;
+    Pizza = regNoun "pico" ;
+    Very quality = {s = \\n => "tre" ++ quality.s ! n} ;
+    Fresh = regAdj "freŝa" ;
+    Warm = regAdj "varma" ;
+    Italian = regAdj "itala" ;
+    Expensive = regAdj "altekosta" ;
+    Delicious = regAdj "bongusta" ;
+    Boring = regAdj "enuiga" ;
+
+  param
+    Number = Sg | Pl ;
+
+  oper
+    det : Number -> Str -> {s : Number => Str} -> {s : Str ; n : Number} = 
+      \n,d,cn -> {
+        s = d ++ cn.s ! n ;
+        n = n
+      } ;
+    regNoun : Str -> {s : Number => Str} = 
+      \vino -> {s = table {Sg => vino ; Pl => vino + "j"}
+	} ;
+    regAdj : Str -> {s : Number => Str} =
+      \nova -> {s = table {Sg => nova ; Pl => nova + "j"}
+      } ;
+    copula : Number => Str = \\_ => "estas" ;
+}
+    

testsuite/lpgf/foods/FoodsFin.gf

@@ -0,0 +1,6 @@
+
+-- (c) 2009 Aarne Ranta under LGPL
+
+concrete FoodsFin of Foods = FoodsI with 
+  (Syntax = SyntaxFin),
+  (LexFoods = LexFoodsFin) ;

testsuite/lpgf/foods/FoodsFre.gf

@@ -0,0 +1,31 @@
+
+concrete FoodsFre of Foods = open SyntaxFre, ParadigmsFre in {
+
+	flags coding = utf8 ;
+	
+	lincat
+		Comment = Utt ;
+		Item = NP ;
+		Kind = CN ;
+		Quality = AP ;
+	
+	lin
+		Pred item quality = mkUtt (mkCl item quality) ;
+		This kind = mkNP this_QuantSg kind ;
+		That kind = mkNP that_QuantSg kind ;
+		These kind = mkNP these_QuantPl kind ;
+		Those kind = mkNP those_QuantPl kind ;
+		Mod quality kind = mkCN quality kind ;
+		Very quality = mkAP very_AdA quality ;
+		
+		Wine = mkCN (mkN "vin" masculine) ;
+		Pizza = mkCN (mkN "pizza" feminine) ;
+		Cheese = mkCN (mkN "fromage" masculine) ;
+		Fish = mkCN (mkN "poisson" masculine) ;
+		Fresh = mkAP (mkA "frais" "fraîche" "frais" "fraîchement") ;
+		Warm = mkAP (mkA "chaud") ;
+		Italian = mkAP (mkA "italien") ;
+		Expensive = mkAP (mkA "cher") ;
+		Delicious = mkAP (mkA "délicieux") ;
+		Boring = mkAP (mkA "ennuyeux") ;
+	}

testsuite/lpgf/foods/FoodsGer.gf

@@ -0,0 +1,6 @@
+
+-- (c) 2009 Aarne Ranta under LGPL
+
+concrete FoodsGer of Foods = FoodsI with 
+  (Syntax = SyntaxGer),
+  (LexFoods = LexFoodsGer) ;

testsuite/lpgf/foods/FoodsGla.gf

@@ -0,0 +1,67 @@
+--# -coding=latin1
+concrete FoodsGla of Foods = open MutationsGla, CharactersGla, Prelude in {
+	param Gender = Masc|Fem ;
+	param Number = Sg|Pl ;
+	param Breadth = Broad|Slender|NoBreadth ;
+	param Beginning = Bcgmp|Other ;
+	
+	lincat Comment = Str;
+	lin Pred item quality = "tha" ++ item ++ quality.s!Sg!Unmutated ;
+
+	lincat Item = Str;
+	lin
+		This kind = (addArticleSg kind) ++ "seo" ;
+		That kind = (addArticleSg kind) ++ "sin";
+		These kind = (addArticlePl kind) ++ "seo" ;
+		Those kind = (addArticlePl kind) ++ "sin" ;
+	oper addArticleSg : {s : Number => Mutation => Str; g : Gender} -> Str =
+						  \kind -> case kind.g of { Masc => "an" ++ kind.s!Sg!PrefixT; Fem => "a'" ++ kind.s!Sg!Lenition1DNTLS } ;
+	oper addArticlePl : {s : Number => Mutation => Str; g : Gender} -> Str =
+					    \kind -> "na" ++ kind.s!Pl!PrefixH ;
+	
+	oper Noun : Type = {s : Number => Mutation => Str; g : Gender; pe : Breadth; beginning: Beginning; };
+	lincat Kind = Noun;
+	lin
+		Mod quality kind = {
+			s = table{
+					Sg => table{mutation => kind.s!Sg!mutation ++ case kind.g of {Masc => quality.s!Sg!Unmutated; Fem => quality.s!Sg!Lenition1} };
+					Pl => table{mutation => kind.s!Pl!mutation ++ case kind.pe of {Slender => quality.s!Pl!Lenition1; _ => quality.s!Pl!Unmutated} }
+			};
+			g = kind.g;
+			pe = kind.pe;
+			beginning = kind.beginning
+		} ;
+		Wine = makeNoun "fìon" "fìontan" Masc ;
+		Cheese = makeNoun "càise" "càisean" Masc ;
+		Fish = makeNoun "iasg" "èisg" Masc ;
+		Pizza = makeNoun "pizza" "pizzathan" Masc ;
+	oper makeNoun : Str -> Str -> Gender -> Noun = \sg,pl,g -> {
+		s = table{Sg => (mutate sg); Pl => (mutate pl)};
+		g = g;
+		pe = pe;
+		beginning = Bcgmp
+	}
+	where {
+		pe : Breadth = case pl of {
+			_ + v@(#broadVowel) + c@(#consonant*) + #consonant => Broad;
+			_ + v@(#slenderVowel) + c@(#consonant*) + #consonant => Slender;
+			_ => NoBreadth
+		}
+	};
+
+	oper Adjective : Type = {s : Number => Mutation => Str; sVery : Number => Str};
+	lincat Quality = Adjective;
+	lin
+		Very quality = {s=table{number => table{_ => quality.sVery!number}}; sVery=quality.sVery } ;
+		Fresh = makeAdjective "úr" "ùra" ;
+		Warm = makeAdjective "blàth" "blàtha" ;
+		Italian = makeAdjective "Eadailteach" "Eadailteach" ;
+		Expensive = makeAdjective "daor" "daora" ;
+		Delicious = makeAdjective "blasta" "blasta" ;
+		Boring = makeAdjective "leamh" "leamha" ;
+	oper makeAdjective : Str -> Str -> Adjective =
+		\sg,pl -> {
+					s=table{Sg => (mutate sg); Pl => (mutate pl)};
+					sVery=table{Sg => "glè"++(lenition1dntls sg); Pl => "glè"++(lenition1dntls pl)}
+				  } ;
+}

testsuite/lpgf/foods/FoodsGle.gf

@@ -0,0 +1,60 @@
+--# -coding=latin1
+concrete FoodsGle of Foods = open MutationsGle, CharactersGle in {
+	param Gender = Masc|Fem ;
+	param Number = Sg|Pl ;
+	param Breadth = Broad|Slender|NoBreadth ;
+	
+	lincat Comment = Str;
+	lin Pred item quality = "tá" ++ item ++ quality.s!Sg!Unmutated ;
+
+	lincat Item = Str;
+	lin
+		This kind = (addArticleSg kind) ++ "seo" ;
+		That kind = (addArticleSg kind) ++ "sin";
+		These kind = (addArticlePl kind) ++ "seo" ;
+		Those kind = (addArticlePl kind) ++ "sin" ;
+	oper addArticleSg : {s : Number => Mutation => Str; g : Gender} -> Str =
+					    \kind -> "an" ++ case kind.g of { Masc => kind.s!Sg!PrefixT; Fem => kind.s!Sg!Lenition1DNTLS } ;
+	oper addArticlePl : {s : Number => Mutation => Str; g : Gender} -> Str =
+					    \kind -> "na" ++ kind.s!Pl!PrefixH ;
+	
+	lincat Kind = {s : Number => Mutation => Str; g : Gender; pe : Breadth} ;
+	lin
+		Mod quality kind = {
+			s = table{
+					Sg => table{mutation => kind.s!Sg!mutation ++ case kind.g of {Masc => quality.s!Sg!Unmutated; Fem => quality.s!Sg!Lenition1} };
+					Pl => table{mutation => kind.s!Pl!mutation ++ case kind.pe of {Slender => quality.s!Pl!Lenition1; _ => quality.s!Pl!Unmutated} }
+			};
+			g = kind.g;
+			pe = kind.pe
+		} ;
+		Wine = makeNoun "fíon" "fíonta" Masc ;
+		Cheese = makeNoun "cáis" "cáiseanna" Fem ;
+		Fish = makeNoun "iasc" "éisc" Masc ;
+		Pizza = makeNoun "píotsa" "píotsaí" Masc ;
+	oper makeNoun : Str -> Str -> Gender -> {s : Number => Mutation => Str; g : Gender; pe : Breadth} =
+		\sg,pl,g -> {
+						s = table{Sg => (mutate sg); Pl => (mutate pl)};
+						g = g;
+						pe = case pl of {
+							_ + v@(#broadVowel) + c@(#consonant*) + #consonant => Broad;
+							_ + v@(#slenderVowel) + c@(#consonant*) + #consonant => Slender;
+							_ => NoBreadth
+						}
+					} ;
+
+	lincat Quality = {s : Number => Mutation => Str; sVery : Number => Str} ;
+	lin
+		Very quality = {s=table{number => table{_ => quality.sVery!number}}; sVery=quality.sVery } ;
+		Fresh = makeAdjective "úr" "úra" ;
+		Warm = makeAdjective "te" "te" ;
+		Italian = makeAdjective "Iodálach" "Iodálacha" ;
+		Expensive = makeAdjective "daor" "daora" ;
+		Delicious = makeAdjective "blasta" "blasta" ;
+		Boring = makeAdjective "leamh" "leamha" ;
+	oper makeAdjective : Str -> Str -> {s : Number => Mutation => Str; sVery : Number => Str} =
+		\sg,pl -> {
+					s=table{Sg => (mutate sg); Pl => (mutate pl)};
+					sVery=table{Sg => "an-"+(lenition1dntls sg); Pl => "an-"+(lenition1dntls pl)}
+				  } ;
+}

testsuite/lpgf/foods/FoodsHeb.gf

@@ -0,0 +1,107 @@
+
+--(c) 2009 Dana Dannells
+-- Licensed under LGPL
+
+concrete FoodsHeb of Foods = open Prelude in {
+  
+  flags coding=utf8 ;
+
+    lincat
+      Comment = SS ;
+      Quality = {s: Number => Species => Gender =>  Str} ;  
+      Kind = {s : Number => Species => Str ; g : Gender ; mod : Modified} ; 
+      Item = {s : Str ; g : Gender ; n : Number ; sp : Species ; mod : Modified} ; 
+  
+ 
+    lin
+      Pred item quality = ss (item.s ++ quality.s ! item.n ! Indef ! item.g ) ; 
+      This  = det Sg Def "הזה" "הזאת"; 
+      That  = det Sg Def "ההוא" "ההיא" ; 
+      These = det Pl Def "האלה" "האלה" ; 
+      Those = det Pl Def "ההם" "ההן" ; 
+      Mod quality kind = {
+	s = \\n,sp => kind.s ! n ! sp ++ quality.s ! n ! sp ! kind.g;
+	g = kind.g ;
+	mod = T
+	} ;     
+      Wine = regNoun "יין" "יינות" Masc ; 
+      Cheese = regNoun "גבינה" "גבינות" Fem ;  
+      Fish = regNoun "דג" "דגים" Masc ; 
+      Pizza = regNoun "פיצה" "פיצות" Fem ; 
+      Very qual = {s = \\g,n,sp => "מאוד" ++  qual.s ! g ! n ! sp} ;
+      Fresh = regAdj "טרי" ; 
+      Warm = regAdj "חם" ;
+      Italian = regAdj2 "איטלקי" ;
+      Expensive = regAdj "יקר" ; 
+      Delicious = regAdj "טעים" ; 
+      Boring = regAdj2 "משעמם"; 
+
+    param 
+      Number = Sg | Pl ;
+      Gender = Masc | Fem ;
+      Species = Def | Indef ;  
+      Modified = T | F ;
+
+    oper
+	Noun : Type = {s : Number => Species => Str ; g : Gender ; mod : Modified } ;
+  	Adj : Type = {s : Number => Species => Gender => Str} ;
+
+      det : Number -> Species -> Str -> Str -> Noun -> 
+	{s : Str ; g :Gender ; n : Number ; sp : Species ; mod : Modified} = 
+        \n,sp,m,f,cn -> {
+	  s = case cn.mod of { _ => cn.s ! n ! sp ++ case cn.g of {Masc => m ; Fem  => f} };
+	  g = cn.g ; 
+          n = n ;
+	  sp = sp ;
+	  mod = cn.mod
+        } ;
+      
+	noun : (gvina,hagvina,gvinot,hagvinot : Str) ->  Gender -> Noun =  
+      		\gvina,hagvina,gvinot,hagvinot,g -> {
+        	s = table {
+          		Sg  => table {
+             			Indef => gvina ;
+             			Def =>  hagvina 
+            		} ;
+          		Pl => table {
+             			Indef => gvinot ;
+             			Def => hagvinot  
+            		} 
+       	  	} ;
+        	g = g ;
+		mod = F 
+      } ;
+
+	regNoun : Str -> Str -> Gender -> Noun = 
+	        \gvina,gvinot, g -> 
+		noun gvina (defH gvina) gvinot (defH gvinot) g ; 
+
+      defH : Str -> Str = \cn ->
+	case cn of {_ => "ה" + cn};	
+
+      replaceLastLetter : Str -> Str = \c ->
+	 case c of {"ף" => "פ" ; "ם" => "מ" ; "ן" => "נ" ; "ץ" => "צ" ; "ך" => "כ"; _ => c} ;
+	      
+      adjective : (_,_,_,_ : Str) -> Adj = 
+       \tov,tova,tovim,tovot -> {
+        s = table {
+          Sg => table { 
+			Indef => table { Masc => tov ; Fem => tova } ; 
+			Def => table { Masc => defH tov ; Fem => defH tova }  
+            		} ; 
+          Pl => table { 
+			Indef => table {Masc => tovim ; Fem  => tovot } ; 
+			Def => table { Masc => defH tovim ; Fem  => defH tovot }  
+            		}
+	}
+      } ;
+    
+      regAdj : Str -> Adj = \tov ->
+	case tov of { to + c@? =>
+	adjective tov (to + replaceLastLetter (c) + "ה" ) (to + replaceLastLetter (c) +"ים" ) (to + replaceLastLetter (c) + "ות" )};	 
+     
+     regAdj2 : Str -> Adj = \italki ->
+ 	case italki of { italk+ c@? => 
+    adjective italki (italk + replaceLastLetter (c)  +"ת" )  (italk + replaceLastLetter (c)+ "ים" ) (italk + replaceLastLetter (c)  + "ות" )};
+
+}  -- FoodsHeb  

testsuite/lpgf/foods/FoodsHin.gf

@@ -0,0 +1,75 @@
+-- (c) 2010 Vikash Rauniyar under LGPL
+
+concrete FoodsHin of Foods = {
+
+  flags coding=utf8 ;
+
+  param
+    Gender = Masc | Fem ;
+    Number = Sg | Pl ;
+  lincat
+    Comment = {s : Str} ;
+    Item    = {s : Str ; g : Gender ; n : Number} ;
+    Kind    = {s : Number => Str ; g : Gender} ;
+    Quality = {s : Gender => Number => Str} ;
+  lin
+    Pred item quality = {
+      s = item.s ++ quality.s ! item.g ! item.n ++ copula item.n
+      } ;
+    This kind = {s = "यह" ++ kind.s ! Sg ; g = kind.g ; n = Sg} ;
+    That kind = {s = "वह" ++ kind.s ! Sg ; g = kind.g ; n = Sg} ;
+    These kind = {s = "ये" ++ kind.s ! Pl ; g = kind.g ; n = Pl} ;
+    Those kind = {s = "वे" ++ kind.s ! Pl ; g = kind.g ; n = Pl} ;
+    Mod quality kind = {
+      s = \\n => quality.s ! kind.g ! n ++ kind.s ! n ; 
+      g = kind.g
+      } ;
+    Wine = regN "मदिरा" ;
+    Cheese = regN "पनीर" ;
+    Fish = regN "मछली" ;
+    Pizza = regN "पिज़्ज़ा" ;
+    Very quality = {s = \\g,n => "अति" ++ quality.s ! g ! n} ;
+    Fresh = regAdj "ताज़ा" ;
+    Warm = regAdj "गरम" ;
+    Italian = regAdj "इटली" ; 
+    Expensive = regAdj "बहुमूल्य" ;
+    Delicious = regAdj "स्वादिष्ट" ;
+    Boring = regAdj "अरुचिकर" ;
+
+  oper
+    mkN : Str -> Str -> Gender -> {s : Number => Str ; g : Gender} = 
+      \s,p,g -> {
+        s = table {
+          Sg => s ;
+          Pl => p
+          } ;
+        g = g
+      } ;
+
+    regN : Str -> {s : Number => Str ; g : Gender} = \s -> case s of {
+      lark + "ा" => mkN s (lark + "े") Masc ;
+      lark + "ी" => mkN s (lark + "ीयँा") Fem ;
+      _           => mkN s s Masc 
+      } ;
+
+    mkAdj : Str -> Str -> Str -> {s : Gender => Number => Str} = \ms,mp,f -> {
+      s = table {
+        Masc => table {
+          Sg => ms ;
+          Pl => mp
+          } ;
+        Fem  => \\_ => f
+        }
+      } ;
+
+    regAdj : Str -> {s : Gender => Number => Str} = \a -> case a of {
+      acch + "ा" => mkAdj a (acch + "े") (acch + "ी") ;
+      _          => mkAdj a a a
+      } ;
+
+    copula : Number -> Str = \n -> case n of {
+      Sg => "है" ;
+      Pl => "हैं"
+      } ;
+
+  }

testsuite/lpgf/foods/FoodsI.gf

@@ -0,0 +1,29 @@
+-- (c) 2009 Aarne Ranta under LGPL
+
+incomplete concrete FoodsI of Foods = 
+    open Syntax, LexFoods in {
+  lincat
+    Comment = Utt ; 
+    Item = NP ;
+    Kind = CN ;
+    Quality = AP ;
+  lin
+    Pred item quality = mkUtt (mkCl item quality) ;
+    This kind = mkNP this_Det kind ;
+    That kind = mkNP that_Det kind ;
+    These kind = mkNP these_Det kind ;
+    Those kind = mkNP those_Det kind ;
+    Mod quality kind = mkCN quality kind ;
+    Very quality = mkAP very_AdA quality ;
+
+    Wine = mkCN wine_N ;
+    Pizza = mkCN pizza_N ;
+    Cheese = mkCN cheese_N ;
+    Fish = mkCN fish_N ;
+    Fresh = mkAP fresh_A ;
+    Warm = mkAP warm_A ;
+    Italian = mkAP italian_A ;
+    Expensive = mkAP expensive_A ;
+    Delicious = mkAP delicious_A ;
+    Boring = mkAP boring_A ;
+}

testsuite/lpgf/foods/FoodsIce.gf

@@ -0,0 +1,83 @@
+
+-- (c) 2009 Martha Dis Brandt under LGPL
+
+concrete FoodsIce of Foods = open Prelude in {
+
+  flags coding=utf8;
+
+  lincat
+    Comment = SS ; 
+    Quality = {s : Gender => Number => Defin => Str} ; 
+    Kind = {s : Number => Str ; g : Gender} ; 
+    Item = {s : Str ; g : Gender ; n : Number} ; 
+
+  lin
+    Pred item quality =  ss (item.s ++ copula item.n ++ quality.s ! item.g ! item.n ! Ind) ;
+         This, That  = det Sg "þessi"   "þessi"  "þetta" ;
+         These, Those = det Pl "þessir" "þessar" "þessi" ;
+    Mod quality kind = { s = \\n => quality.s ! kind.g ! n ! Def ++ kind.s ! n ; g = kind.g } ;
+         Wine = noun "vín" "vín" Neutr ;
+         Cheese = noun "ostur" "ostar" Masc ; 
+         Fish = noun "fiskur" "fiskar" Masc ; 
+         -- the word "pizza" is more commonly used in Iceland, but "flatbaka" is the Icelandic word for it
+         Pizza = noun "flatbaka" "flatbökur" Fem ;
+    Very qual = {s = \\g,n,defOrInd => "mjög" ++ qual.s ! g ! n ! defOrInd } ;
+         Fresh = regAdj "ferskur" ;
+         Warm = regAdj "heitur" ;
+         Boring = regAdj "leiðinlegur" ;
+         -- the order of the given adj forms is: mSg fSg nSg mPl fPl nPl mSgDef f/nSgDef _PlDef
+         Italian = adjective "ítalskur" "ítölsk" "ítalskt" "ítalskir" "ítalskar" "ítölsk" "ítalski" "ítalska" "ítalsku" ;
+         Expensive = adjective "dýr" "dýr" "dýrt" "dýrir" "dýrar" "dýr" "dýri" "dýra" "dýru" ; 
+         Delicious = adjective "ljúffengur" "ljúffeng" "ljúffengt" "ljúffengir" "ljúffengar" "ljúffeng" "ljúffengi" "ljúffenga" "ljúffengu" ;
+
+  param
+    Number = Sg | Pl ;
+    Gender = Masc | Fem | Neutr ;
+    Defin = Ind | Def ;
+
+  oper
+    det : Number -> Str -> Str -> Str -> {s : Number => Str ; g : Gender} -> 
+        {s : Str ; g : Gender ; n : Number} = 
+      \n,masc,fem,neutr,cn -> {
+        s = case cn.g of {Masc => masc ; Fem => fem; Neutr => neutr } ++ cn.s ! n ;
+        g = cn.g ;
+        n = n
+      } ;
+
+    noun : Str -> Str -> Gender -> {s : Number => Str ; g : Gender} = 
+      \man,men,g -> {
+        s = table {
+          Sg => man ;
+          Pl => men 
+          } ;
+        g = g
+      } ;
+
+    adjective : (x1,_,_,_,_,_,_,_,x9 : Str) -> {s : Gender => Number => Defin => Str} =
+      \ferskur,fersk,ferskt,ferskir,ferskar,fersk_pl,ferski,ferska,fersku -> {
+         s = \\g,n,t => case <g,n,t> of {
+            < Masc, Sg, Ind > => ferskur ;
+            < Masc, Pl, Ind > => ferskir ;
+            < Fem, Sg, Ind > => fersk ;
+            < Fem, Pl, Ind > => ferskar ;
+            < Neutr, Sg, Ind > => ferskt ;
+            < Neutr, Pl, Ind > => fersk_pl;
+            < Masc, Sg, Def > => ferski ;
+            < Fem, Sg, Def > | < Neutr, Sg, Def > => ferska ;
+            < _ , Pl, Def > => fersku 
+            }
+          } ;
+
+    regAdj : Str -> {s : Gender => Number => Defin => Str} = \ferskur ->
+      let fersk = Predef.tk 2 ferskur
+      in adjective
+        ferskur fersk (fersk + "t")
+        (fersk + "ir") (fersk + "ar") fersk
+        (fersk + "i") (fersk + "a") (fersk + "u") ;
+
+    copula : Number -> Str = 
+      \n -> case n of {
+        Sg => "er" ;
+        Pl => "eru"
+        } ;
+}

testsuite/lpgf/foods/FoodsIta.gf

@@ -0,0 +1,7 @@
+
+-- (c) 2009 Aarne Ranta under LGPL
+
+concrete FoodsIta of Foods = FoodsI with 
+  (Syntax = SyntaxIta),
+  (LexFoods = LexFoodsIta) ;
+

testsuite/lpgf/foods/FoodsJpn.gf

@@ -0,0 +1,71 @@
+
+-- (c) 2009 Zofia Stankiewicz under LGPL
+
+concrete FoodsJpn of Foods = open Prelude in {
+
+flags coding=utf8 ;
+
+  lincat
+    Comment = {s: Style => Str};
+    Quality = {s: AdjUse => Str ; t: AdjType} ;
+    Kind = {s : Number => Str} ; 
+    Item = {s : Str ; n : Number} ; 
+
+  lin
+    Pred item quality = {s = case quality.t of {
+      IAdj => table {Plain => item.s ++ quality.s ! APred ; Polite => item.s ++ quality.s ! APred ++ copula ! Polite ! item.n } ;
+      NaAdj => \\p => item.s ++ quality.s ! APred ++ copula ! p ! item.n } 
+      } ;
+    This  = det Sg "この" ;
+    That  = det Sg "その" ;
+    These = det Pl "この" ;
+    Those = det Pl "その" ;
+    Mod quality kind = {s = \\n => quality.s ! Attr ++ kind.s ! n} ;
+    Wine = regNoun "ワインは" ;
+    Cheese = regNoun "チーズは" ;
+    Fish = regNoun "魚は" ;
+    Pizza = regNoun "ピザは" ;
+    Very quality =  {s = \\a => "とても" ++ quality.s ! a ; t = quality.t } ;
+    Fresh = adj "新鮮な" "新鮮";
+    Warm = regAdj "あたたかい" ;
+    Italian = adj "イタリアの" "イタリアのもの";
+    Expensive = regAdj "たかい" ;
+    Delicious = regAdj "おいしい" ;
+    Boring = regAdj "つまらない" ;
+
+  param
+    Number = Sg | Pl ;
+    AdjUse = Attr | APred ;        -- na-adjectives have different forms as noun attributes and predicates
+    Style = Plain | Polite ;      -- for phrase types
+    AdjType = IAdj | NaAdj ;      -- IAdj can form predicates without the copula, NaAdj cannot
+
+  oper
+    det : Number -> Str -> {s : Number => Str} -> {s : Str ; n : Number} = 
+      \n,d,cn -> {
+        s = d ++ cn.s ! n ;
+        n = n
+      } ;
+   noun : Str -> Str -> {s : Number => Str} = 
+      \sakana,sakana -> {s = \\_ => sakana } ;
+
+   regNoun : Str -> {s : Number => Str} = 
+      \sakana -> noun sakana sakana ;
+
+   adj : Str -> Str -> {s : AdjUse => Str ; t : AdjType} =
+      \chosenna, chosen -> {
+       s = table { 
+         Attr => chosenna ;
+         APred => chosen
+       } ;
+       t = NaAdj 
+      } ;
+   
+   regAdj : Str -> {s: AdjUse => Str ; t : AdjType} =\akai -> {
+     s = \\_ => akai ; t = IAdj} ;
+
+    copula : Style => Number => Str = 
+      table { 
+        Plain => \\_ => "だ" ;
+        Polite => \\_ => "です" } ;
+
+}   

testsuite/lpgf/foods/FoodsLat.gf

@@ -0,0 +1,76 @@
+--# -path=.:present
+
+-- (c) 2009 Aarne Ranta under LGPL
+
+concrete FoodsLat of Foods = LexFoodsLat **
+{
+  lincat
+    Comment = { s : Str } ;
+    Item = { number : Number ; gender : Gender; noun : Str; adj : Str; det : Str };
+  lin
+    Mod quality kind =
+      variants {
+	{
+	  gender = kind.gender ;
+	  noun = table { number => kind.noun ! number ++ quality.s ! number ! kind.gender } ;
+	  adj = kind.adj
+	  } ;
+	{
+	  gender = kind.gender ;
+	  noun = kind.noun ;
+	  adj = table { number => kind.adj ! number ++ quality.s ! number ! kind.gender }
+	  } ;
+	{
+	  gender = kind.gender ;
+	  noun = table { number => quality.s ! number ! kind.gender ++ kind.noun ! number } ;
+	  adj = kind.adj
+	  } ;
+       	{
+      	  gender = kind.gender ;
+      	  noun = kind.noun ;
+      	  adj = table { number => quality.s ! number ! kind.gender ++ kind.adj ! number }
+      	  }
+      };
+    Pred item quality =
+      let aux : Number => Str =
+	    table { Sg => "est" ; Pl => "sunt" } ;
+      in
+      {
+	s = variants {
+	  item.det ++ item.noun ++ item.adj ++ aux ! item.number ++ quality.s ! item.number ! item.gender ;
+	  item.det ++ item.adj ++ item.noun ++ aux ! item.number ++ quality.s ! item.number ! item.gender ;
+	  item.det ++ item.noun ++ item.adj ++ quality.s ! item.number ! item.gender ++ aux ! item.number ;
+	  item.det ++ item.adj ++ item.noun  ++ quality.s ! item.number ! item.gender ++ aux ! item.number
+	  };
+      };
+    This kind = {
+      number = Sg ;
+      gender = kind.gender ;
+      noun = kind.noun ! Sg ;
+      adj = kind.adj ! Sg ;
+      det = table { Male => "hic" ; Female => "haec" ; Neuter => "hoc" } ! kind.gender
+      } ;
+    These kind = {
+      number = Pl ;
+      gender = kind.gender ;
+      noun = kind.noun ! Pl ;
+      adj = kind.adj ! Pl ;
+      det = table { Male => "hi" ; Female => "hae" ; Neuter => "haec" } ! kind.gender
+      } ;
+    That kind = {
+      number = Sg ;
+      gender = kind.gender ;
+      noun = kind.noun ! Sg ;
+      adj = kind.adj ! Sg ;
+      det = table { Male => "is" ; Female => "ea" ; Neuter => "id" } ! kind.gender
+      } ;
+    Those kind = {
+      number = Pl ;
+      gender = kind.gender ;
+      noun = kind.noun ! Pl ;
+      adj = kind.adj ! Pl ;
+      det = table { Male => variants { "ei "; "ii" } ; Female => "eae" ; Neuter => "ea" } ! kind.gender
+      } ;
+    Very quality = { s = \\n,g => "valde" ++ quality.s ! n ! g };
+}
+

testsuite/lpgf/foods/FoodsLav.gf

@@ -0,0 +1,90 @@
+
+-- (c) 2009 Inese Bernsone under LGPL
+
+concrete FoodsLav of Foods = open Prelude in {
+
+  flags
+    coding=utf8 ;
+    
+  lincat
+    Comment = SS ; 
+    Quality = {s : Q => Gender => Number => Defin => Str } ; 
+    Kind = {s : Number => Str ; g : Gender} ; 
+    Item = {s : Str ; g : Gender ; n : Number } ; 
+
+  lin
+    Pred item quality = ss (item.s ++ {- copula item.n -} "ir" ++ quality.s ! Q1 ! item.g ! item.n ! Ind ) ;
+      This  = det Sg "šis" "šī" ;
+      That  = det Sg "tas" "tā" ;
+      These = det Pl "šie" "šīs" ;
+      Those = det Pl "tie" "tās" ;
+    Mod quality kind = {s = \\n => quality.s ! Q1 ! kind.g ! n ! Def ++ kind.s ! n ; g = kind.g } ;
+      Wine = noun "vīns" "vīni" Masc ;
+      Cheese = noun "siers" "sieri" Masc ;
+      Fish = noun "zivs" "zivis" Fem ;
+      Pizza = noun "pica" "picas" Fem ;
+    Very qual = {s = \\q,g,n,spec => "ļoti" ++ qual.s ! Q2 ! g ! n ! spec }; 
+ 
+      Fresh = adjective "svaigs" "svaiga" "svaigi" "svaigas" "svaigais" "svaigā" "svaigie" "svaigās" ;
+      Warm = regAdj "silts" ;
+      Italian = specAdj "itāļu" (regAdj "itālisks") ;
+      Expensive = regAdj "dārgs" ;
+      Delicious = regAdj "garšīgs" ;
+      Boring = regAdj "garlaicīgs" ;
+
+  param
+    Number = Sg | Pl ;
+    Gender = Masc | Fem ;
+    Defin = Ind | Def ;
+    Q = Q1 | Q2 ;
+
+  oper
+   det : Number -> Str -> Str -> {s : Number => Str ; g : Gender} -> 
+        {s : Str ; g : Gender ; n : Number} = 
+      \n,m,f,cn -> {
+        s = case cn.g of {Masc => m ; Fem => f} ++ cn.s ! n ;
+        g = cn.g ;
+        n = n
+      } ;
+    noun : Str -> Str -> Gender -> {s : Number => Str ; g : Gender} = 
+      \man,men,g -> {
+        s = table {
+          Sg => man ;
+          Pl => men 
+          } ;
+        g = g
+      } ;
+    adjective : (_,_,_,_,_,_,_,_ : Str) -> {s : Q => Gender => Number => Defin => Str} = 
+      \skaists,skaista,skaisti,skaistas,skaistais,skaistaa,skaistie,skaistaas -> {
+        s = table {
+		  _ => table {
+            Masc => table {
+              Sg => table {Ind => skaists ; Def => skaistais} ;
+              Pl => table {Ind => skaisti ; Def => skaistie}
+              } ; 
+            Fem => table {
+              Sg => table {Ind => skaista ; Def => skaistaa} ;
+              Pl => table {Ind => skaistas ; Def => skaistaas} 
+              }
+            } 
+		  }
+        } ;
+      
+ {-   irregAdj : Str -> {s : Gender => Number => Defin => Str} = \itaalju ->
+     let itaalju = itaalju
+     in adjective itaalju (itaalju) (itaalju) (itaalju) (itaalju) (itaalju) (itaalju) (itaalju) ; -}
+     
+    regAdj : Str -> {s : Q => Gender => Number => Defin => Str} = \skaists ->
+      let skaist = init skaists 
+      in adjective skaists (skaist + "a") (skaist + "i") (skaist + "as") (skaist + "ais") (skaist + "ā") (skaist + "ie") (skaist + "ās");
+
+    Adjective : Type = {s : Q => Gender => Number => Defin => Str} ;
+
+	specAdj : Str -> Adjective -> Adjective = \s,a -> {
+      s = table {
+        Q2 => a.s ! Q1 ;
+        Q1 => \\_,_,_ => s
+        }		
+	  } ;
+	
+	}

testsuite/lpgf/foods/FoodsMkd.gf

@@ -0,0 +1,120 @@
+-- (c) 2009 Krasimir Angelov under LGPL
+
+concrete FoodsMkd of Foods = {
+
+flags coding = utf8 ;
+
+lincat
+    Comment = Str;
+    Quality = {s : Agr => Str};
+    Item = {s : Str; a : Agr};
+    Kind = {s : Number => Str; g : Gender};
+
+lin
+    Pred item qual = 
+       item.s ++
+       case item.a of {
+         ASg _ => "е";
+         APl => "се"
+       } ++
+       qual.s ! item.a;
+    This kind = {
+       s = case kind.g of {
+             Masc  => "овоj";
+             Fem   => "оваа";
+             Neutr => "ова"
+           } ++
+           kind.s ! Sg;
+       a = ASg kind.g};
+    That kind = {
+       s = case kind.g of {
+             Masc  => "оноj";
+             Fem   => "онаа";
+             Neutr => "она"
+           } ++ 
+           kind.s ! Sg;
+       a = ASg kind.g};
+    These kind = {s = "овие" ++ kind.s ! Pl; a = APl};
+    Those kind = {s = "оние" ++ kind.s ! Pl; a = APl};
+    Mod qual kind = {
+       s = \\n => qual.s ! case n of {
+                             Sg => ASg kind.g;
+                             Pl => APl
+                           } ++
+                  kind.s ! n;
+       g = kind.g};
+    Wine  = {
+       s = table {
+             Sg => "вино";
+             Pl => "вина"
+       };
+       g = Neutr};
+    Cheese = {
+       s = table {
+             Sg => "сирење";
+             Pl => "сирењa"
+           };
+       g = Neutr};
+    Fish = {
+       s = table {
+             Sg => "риба";
+             Pl => "риби"
+       };
+       g = Fem};
+    Pizza = {
+       s = table {
+             Sg => "пица";
+             Pl => "пици"
+           };
+       g = Fem
+       };
+    Very qual = {s = \\g => "многу" ++ qual.s ! g};
+    Fresh = {
+       s = table {
+             ASg Masc  => "свеж";
+             ASg Fem   => "свежа";
+             ASg Neutr => "свежо";
+             APl       => "свежи"}
+       };
+    Warm  = {
+      s = table {
+            ASg Masc  => "топол";
+            ASg Fem   => "топла";
+            ASg Neutr => "топло";
+            APl       => "топли"}
+      };
+    Italian  = {
+      s = table {
+            ASg Masc  => "италијански";
+            ASg Fem   => "италијанска";
+            ASg Neutr => "италијанско";
+            APl       => "италијански"}
+      };
+    Expensive  = {
+       s = table {
+             ASg Masc  => "скап";
+             ASg Fem   => "скапа";
+             ASg Neutr => "скапо";
+             APl       => "скапи"}
+       };
+    Delicious  = {
+       s = table {
+             ASg Masc  => "вкусен";
+             ASg Fem   => "вкусна";
+             ASg Neutr => "вкусно";
+             APl       => "вкусни"}
+       };
+    Boring  = {
+       s = table {
+             ASg Masc  => "досаден";
+             ASg Fem   => "досадна";
+             ASg Neutr => "досадно";
+             APl       => "досадни"}
+       };
+
+param
+    Gender = Masc | Fem | Neutr;
+    Number = Sg | Pl;
+    Agr = ASg Gender | APl;
+
+}

testsuite/lpgf/foods/FoodsMlt.gf

@@ -0,0 +1,105 @@
+-- (c) 2013 John J. Camilleri under LGPL
+
+concrete FoodsMlt of Foods = open Prelude in {
+  flags coding=utf8 ;
+
+  lincat
+    Comment = SS ;
+    Quality = {s : Gender => Number => Str} ;
+    Kind = {s : Number => Str ; g : Gender} ;
+    Item = {s : Str ; g : Gender ; n : Number} ;
+
+  lin
+    -- Pred item quality = ss (item.s ++ copula item.n item.g ++ quality.s ! item.g ! item.n) ;
+    Pred item quality = ss (item.s ++ quality.s ! item.g ! item.n) ;
+
+    This kind = det Sg "dan" "din" kind ;
+    That kind = det Sg "dak" "dik" kind ;
+    These kind = det Pl "dawn" "" kind ;
+    Those kind = det Pl "dawk" "" kind ;
+
+    Mod quality kind = {
+      s = \\n => kind.s ! n ++ quality.s ! kind.g ! n ;
+      g = kind.g
+      } ;
+
+    Wine = noun "inbid" "inbejjed" Masc ;
+    Cheese = noun "ġobon" "ġobniet" Masc ;
+    Fish = noun "ħuta" "ħut" Fem ;
+    Pizza = noun "pizza" "pizzez" Fem ;
+
+    Very qual = {s = \\g,n => qual.s ! g ! n ++ "ħafna"} ;
+
+    Warm = adjective "sħun" "sħuna" "sħan" ;
+    Expensive = adjective "għali" "għalja" "għaljin" ;
+    Delicious = adjective "tajjeb" "tajba" "tajbin" ;
+    Boring = uniAdj "tad-dwejjaq" ;
+    Fresh = regAdj "frisk" ;
+    Italian = regAdj "Taljan" ;
+
+  param
+    Number = Sg | Pl ;
+    Gender = Masc | Fem ;
+
+  oper
+    --Create an adjective (full function)
+    --Params: Sing Masc, Sing Fem, Plural
+    adjective : (_,_,_ : Str) -> {s : Gender => Number => Str} = \iswed,sewda,suwed -> {
+      s = table {
+	Masc => table {
+	  Sg => iswed ;
+	  Pl => suwed
+	  } ;
+	Fem => table {
+	  Sg => sewda ;
+	  Pl => suwed
+	  }
+	}
+      } ;
+
+    --Create a regular adjective
+    --Param: Sing Masc
+    regAdj : Str -> {s : Gender => Number => Str} = \frisk ->
+      adjective frisk (frisk + "a") (frisk + "i") ;
+
+    --Create a "uni-adjective" eg tal-buzz
+    --Param: Sing Masc
+    uniAdj : Str -> {s : Gender => Number => Str} = \uni ->
+      adjective uni uni uni ;
+
+    --Create a noun
+    --Params: Singular, Plural, Gender (inherent)
+    noun : Str -> Str -> Gender -> {s : Number => Str ; g : Gender} = \ktieb,kotba,g -> {
+      s = table {
+	Sg => ktieb ;
+	Pl => kotba
+	} ;
+      g = g
+      } ;
+
+    --Copula is a linking verb
+    --Params: Number, Gender
+    -- copula : Number -> Gender -> Str = \n,g -> case n of {
+    --   Sg => case g of { Masc => "huwa" ; Fem => "hija" } ;
+    --   Pl => "huma"
+    --   } ;
+
+    --Create an article, taking into account first letter of next word
+    article = pre {
+      "a"|"e"|"i"|"o"|"u" => "l-" ;
+      --cons@("ċ"|"d"|"n"|"r"|"s"|"t"|"x"|"ż") => "i" + cons + "-" ;
+      _ => "il-"
+      } ;
+
+    --Create a determinant
+    --Params: Sg/Pl, Masc, Fem
+    det : Number -> Str -> Str -> {s : Number => Str ; g : Gender} -> {s : Str ; g : Gender ; n : Number} = \n,m,f,cn -> {
+      s = case n of {
+	Sg => case cn.g of {Masc => m ; Fem => f}; --string
+	Pl => m --default to masc
+	} ++ article ++ cn.s ! n ;
+      g = cn.g ; --gender
+      n = n --number
+      } ;
+
+}

testsuite/lpgf/foods/FoodsMon.gf

@@ -0,0 +1,48 @@
+
+-- (c) 2009 Nyamsuren Erdenebadrakh under LGPL
+
+concrete FoodsMon of Foods = open Prelude in {
+  flags coding=utf8;
+
+  lincat
+    Comment, Quality = SS ; 
+	Kind = {s : Number => Str} ; 
+    Item = {s : Str ; n : Number} ; 
+
+  lin
+	Pred item quality = ss (item.s ++ "бол" ++ quality.s) ;
+	This  = det Sg "энэ" ;
+	That  = det Sg "тэр" ;
+	These = det Pl "эдгээр" ;
+	Those = det Pl "тэдгээр" ;
+	Mod quality kind = {s = \\n => quality.s ++ kind.s ! n} ;
+	Wine = regNoun "дарс" ;
+	Cheese = regNoun "бяслаг" ;
+	Fish = regNoun "загас" ;
+	Pizza = regNoun "пицца" ;
+	Very = prefixSS "маш" ;
+	Fresh = ss "шинэ" ;
+	Warm = ss "халуун" ;
+	Italian = ss "итали" ;
+	Expensive = ss "үнэтэй" ;
+	Delicious = ss "амттай" ;
+	Boring = ss "амтгүй" ;
+
+  param
+    Number = Sg | Pl ;
+
+  oper
+	det : Number -> Str -> {s : Number => Str} -> {s : Str ; n : Number} = 
+	\n,d,cn -> {
+		s = d ++ cn.s ! n ;
+		n = n
+	} ;
+  	
+	regNoun : Str -> {s : Number => Str} = 
+	\x -> {s = table {
+		Sg => x ; 
+		Pl => x + "нууд"}
+		} ;
+	}
+	 
+    

testsuite/lpgf/foods/FoodsNep.gf

@@ -0,0 +1,60 @@
+-- (c) 2011 Dinesh Simkhada under LGPL
+
+concrete FoodsNep of Foods = {
+
+  flags coding = utf8 ;
+
+  lincat
+    Comment, Quality = {s : Str} ; 
+    Kind = {s : Number => Str} ; 
+    Item = {s : Str ; n : Number} ; 
+    
+  lin
+    Pred item quality = 
+      {s = item.s ++ quality.s ++ copula ! item.n} ;
+      
+    This  = det Sg "यो" ;
+    That  = det Sg "त्यो" ;
+    These = det Pl "यी" ;
+    Those = det Pl "ती" ;
+    Mod quality kind = 
+      {s = \\n => quality.s ++ kind.s ! n} ;
+      
+    Wine = regNoun "रक्सी" ;
+    Cheese = regNoun "चिज" ;
+    Fish = regNoun "माछा" ;
+    Pizza = regNoun "पिज्जा" ;
+    Very a = {s = "धेरै" ++ a.s} ;
+    Fresh = adj "ताजा" ;
+    Warm = adj "तातो" ;
+    Italian = adj "इटालियन" ;
+    Expensive = adj "महँगो" | adj "बहुमूल्य" ;
+    Delicious = adj "स्वादिष्ट" | adj "मीठो" ;
+    Boring = adjPl "नमिठो" ;
+  
+  param
+    Number = Sg | Pl ;
+    
+  oper
+    det : Number -> Str -> 
+      {s : Number => Str} -> {s : Str ; n : Number} = 
+        \n,det,noun -> {s = det ++ noun.s ! n ; n = n} ;
+    
+    noun : Str -> Str -> {s : Number => Str} = 
+      \man,men -> {s = table {Sg => man ; Pl => men}} ;
+    
+    regNoun : Str -> {s : Number => Str} = 
+      \car -> noun car (car + "हरु") ;
+    
+    adjPl : Str -> {s : Str} = \a -> case a of {
+      bor + "ठो" => adj (bor + "ठा") ;
+      _ => adj a
+      } ;
+      
+    adj : Str -> {s : Str} = 
+      \cold -> {s = cold} ;
+    
+    copula : Number => Str = 
+      table {Sg => "छ" ; Pl => "छन्"} ;
+}
+

testsuite/lpgf/foods/FoodsOri.gf

@@ -0,0 +1,30 @@
+concrete FoodsOri of Foods = {
+
+flags coding = utf8 ;
+
+lincat
+    Comment = Str;
+    Item = Str;
+    Kind = Str;
+    Quality = Str;
+
+lin
+    Pred item quality = item ++ quality ++ "ଅଟେ";
+    This kind = "ଏଇ" ++ kind;
+    That kind = "ସେଇ" ++ kind;
+    These kind = "ଏଇ" ++ kind ++ "ଗୁଡିକ" ;
+    Those kind = "ସେଇ" ++ kind ++ "ଗୁଡିକ" ;
+    Mod quality kind = quality ++ kind;
+    Wine  = "ମଦ";
+    Cheese  = "ଛେନା";
+    Fish  = "ମାଛ";
+    Pizza = "ପିଜଜ଼ା" ;
+    Very quality = "ଅତି" ++ quality;
+    Fresh  = "ତାଜା";
+    Warm  = "ଗରମ";
+    Italian  = "ଇଟାଲି";
+    Expensive  = "ମୁଲ୍ୟବାନ୍";
+    Delicious  = "ସ୍ଵାଦିସ୍ଟ ";
+    Boring  = "ଅରୁଚିକର";
+
+}

testsuite/lpgf/foods/FoodsPes.gf

@@ -0,0 +1,65 @@
+concrete FoodsPes of Foods = {
+
+      flags optimize=noexpand ; coding=utf8 ;
+	  
+      lincat
+        Comment = {s : Str} ;
+		Quality = {s : Add => Str; prep : Str} ;
+        Kind = {s : Add => Number => Str ; prep : Str};
+        Item = {s : Str ; n : Number};
+      lin
+        Pred item quality = {s = item.s ++ quality.s ! Indep ++ copula ! item.n} ;
+        This = det Sg "این" ;
+        That = det Sg "آن" ;
+        These = det Pl "این" ;
+        Those = det Pl "آن" ;
+        
+        Mod quality kind = {s = \\a,n =>  kind.s ! Attr ! n ++ kind.prep ++ quality.s ! a ;                                  
+                            prep = quality.prep             
+                            };
+        Wine = regN "شراب" ; 
+        Cheese = regN "پنیر" ;
+        Fish = regN "ماهى" ;
+        Pizza = regN "پیتزا" ;
+        Very a = {s = \\at => "خیلی" ++ a.s ! at ; prep = a.prep} ;
+        Fresh = adj "تازه" ;
+        Warm = adj "گرم" ;
+        Italian = adj "ایتالیایی" ;
+        Expensive = adj "گران" ;
+        Delicious = adj "لذىذ" ;
+        Boring = adj "ملال آور" ;  -- it must be written as ملال آور. 
+     
+     param
+        Number = Sg | Pl ;
+		Add = Indep | Attr ;
+     oper
+        det : Number -> Str -> {s: Add => Number => Str ; prep : Str} -> {s : Str ; n: Number} =
+           \n,det,noun -> {s = det ++ noun.s ! Indep ! n ; n = n };
+           
+        noun : (x1,_,_,x4 : Str) -> {s : Add => Number => Str ; prep : Str} = \pytzA, pytzAy, pytzAhA,pr -> 
+         {s = \\a,n => case <a,n> of
+		        {<Indep,Sg> => pytzA ; <Indep,Pl> => pytzAhA ;
+  				 <Attr,Sg>  =>pytzA ; <Attr,Pl>  => pytzAhA + "ى" };
+		 prep = pr
+		 };		 
+         
+        regN : Str -> {s: Add => Number => Str ; prep : Str} = \mrd -> 
+		case mrd of 
+		{ _ + ("ا"|"ه"|"ى"|"و"|"") => noun mrd (mrd+"ى") (mrd + "ها") "";
+		  _                        => noun mrd mrd (mrd + "ها") "e"
+		};
+        
+        adj : Str -> {s : Add => Str; prep : Str} = \tAzh -> 
+		case tAzh of 
+		{ _ + ("ا"|"ه"|"ى"|"و"|"") => mkAdj tAzh (tAzh ++ "ى") "" ;
+		  _                        => mkAdj tAzh tAzh "ه"
+        };
+		
+		mkAdj : Str -> Str -> Str -> {s : Add => Str; prep : Str} = \tAzh, tAzhy, pr  ->
+		{s = table {Indep => tAzh;
+		            Attr => tAzhy};
+		 prep = pr 			
+		};
+        copula : Number => Str = table {Sg => "است"; Pl => "هستند"};
+      
+}

testsuite/lpgf/foods/FoodsPor.gf

@@ -0,0 +1,78 @@
+-- (c) 2009 Rami Shashati under LGPL
+--# -coding=latin1
+
+concrete FoodsPor of Foods = open Prelude in {
+	lincat
+	  Comment = {s : Str} ;
+	  Quality = {s : Gender => Number => Str} ;
+	  Kind = {s : Number => Str ; g : Gender} ;
+	  Item = {s : Str ; n : Number ; g : Gender } ;
+	
+	lin 
+	  Pred item quality =
+	    {s = item.s ++ copula ! item.n ++ quality.s ! item.g ! item.n } ;
+	  This = det Sg (table {Masc => "este" ; Fem => "esta"}) ;
+	  That = det Sg (table {Masc => "esse" ; Fem => "essa"}) ;
+	  These = det Pl (table {Masc => "estes" ; Fem => "estas"}) ; 
+	  Those = det Pl (table {Masc => "esses" ; Fem => "essas"}) ;
+	 
+	  Mod quality kind = { s = \\n => kind.s ! n ++ quality.s ! kind.g ! n ; g = kind.g } ;
+	  
+	  Wine = regNoun "vinho" Masc ;
+	  Cheese = regNoun "queijo" Masc ;
+	  Fish = regNoun "peixe" Masc ;
+	  Pizza = regNoun "pizza" Fem ;
+	  
+      Very a = { s = \\g,n => "muito" ++ a.s ! g ! n } ;
+      
+      Fresh = mkAdjReg "fresco" ;
+      Warm = mkAdjReg "quente" ;
+      Italian = mkAdjReg "Italiano" ;
+      Expensive = mkAdjReg "caro" ;
+      Delicious = mkAdjReg "delicioso" ;
+      Boring = mkAdjReg "chato" ;
+	
+	param
+	  Number = Sg | Pl ;
+	  Gender = Masc | Fem ;
+	
+	oper
+	  QualityT : Type = {s : Gender => Number => Str} ;
+	  
+	  mkAdj : (_,_,_,_ : Str) -> QualityT = \bonito,bonita,bonitos,bonitas -> {
+	  	s = table {
+	  		Masc => table { Sg => bonito ; Pl => bonitos } ;
+	  		Fem => table { Sg => bonita ; Pl => bonitas }
+	    } ;
+	  } ;
+	  
+	  -- regular pattern
+	  adjSozinho : Str -> QualityT = \sozinho ->
+        let sozinh = Predef.tk 1 sozinho
+        in mkAdj sozinho (sozinh + "a") (sozinh + "os") (sozinh + "as") ;
+
+      -- for gender-independent adjectives
+      adjUtil : Str -> Str -> QualityT = \util,uteis ->
+        mkAdj util util uteis uteis ;
+
+      -- smart paradigm for adjcetives
+      mkAdjReg : Str -> QualityT = \a -> case last a of {
+      	"o" => adjSozinho a ;
+        "e" => adjUtil a (a + "s")
+      } ;
+      
+      ItemT : Type = {s : Str ; n : Number ; g : Gender } ;
+      
+      det : Number -> (Gender => Str) -> KindT -> ItemT =
+        \num,det,noun -> {s = det ! noun.g ++ noun.s ! num ; n = num ; g = noun.g } ;
+	    
+	  KindT : Type = {s : Number => Str ; g : Gender} ;
+	    
+	  noun : Str -> Str -> Gender -> KindT =
+	    \animal,animais,gen -> {s = table {Sg => animal ; Pl => animais} ; g = gen } ;
+	    
+	  regNoun : Str -> Gender -> KindT =
+	    \carro,gen -> noun carro (carro + "s") gen ;
+	  
+	  copula : Number => Str = table {Sg => "é" ; Pl => "são"} ;
+}

testsuite/lpgf/foods/FoodsRon.gf

@@ -0,0 +1,72 @@
+-- (c) 2009 Ramona Enache under LGPL
+
+concrete FoodsRon of Foods = 
+{
+flags coding=utf8 ;
+
+param Number = Sg | Pl ;
+      Gender = Masc | Fem ;
+      NGender = NMasc | NFem | NNeut ;
+lincat 
+Comment = {s : Str};
+Quality = {s : Number => Gender => Str};
+Kind = {s : Number => Str; g : NGender};
+Item = {s : Str ; n : Number; g : Gender};
+
+lin
+
+This = det Sg (mkTab "acest" "această");
+That = det Sg (mkTab "acel" "acea");
+These = det Pl (mkTab "acești" "aceste");
+Those = det Pl (mkTab "acei" "acele");
+
+Wine = mkNoun "vin" "vinuri" NNeut ;
+Cheese = mkNoun "brânză" "brânzeturi" NFem ;
+Fish = mkNoun "peşte" "peşti" NMasc ;
+Pizza = mkNoun "pizza" "pizze" NFem;
+
+Very a = {s = \\n,g => "foarte" ++ a.s ! n ! g};
+
+Fresh = mkAdj "proaspăt" "proaspătă" "proaspeţi" "proaspete" ;
+Warm = mkAdj "cald" "caldă" "calzi" "calde" ;
+Italian = mkAdj "italian" "italiană" "italieni" "italiene" ;
+Expensive = mkAdj "scump" "scumpă" "scumpi" "scumpe" ;
+Delicious = mkAdj "delicios" "delcioasă" "delicioşi" "delicioase" ;
+Boring = mkAdj "plictisitor" "plictisitoare" "plictisitori" "plictisitoare" ;
+
+Pred item quality = {s = item.s ++ copula ! item.n ++ quality.s ! item.n ! item.g} ;
+
+Mod quality kind = {s = \\n => kind.s ! n ++ quality.s ! n ! (getAgrGender kind.g n) ; g = kind.g};
+
+oper 
+
+mkTab : Str -> Str -> {s : Gender => Str} = \acesta, aceasta ->
+{s = table{Masc => acesta;
+      Fem  => aceasta}};
+
+det : Number -> {s : Gender => Str} -> {s : Number => Str ; g : NGender} -> {s : Str; n : Number; g : Gender} =
+\n,det,noun -> let gg = getAgrGender noun.g n 
+  in
+   {s =  det.s ! gg  ++ noun.s ! n  ; n = n ; g = gg};
+
+mkNoun : Str -> Str -> NGender -> {s : Number => Str; g : NGender} = \peste, pesti,g ->
+{s = table {Sg => peste;
+            Pl => pesti};
+ g = g
+};
+
+oper mkAdj : (x1,_,_,x4 : Str) -> {s : Number => Gender => Str} = \scump, scumpa, scumpi, scumpe ->
+{s = \\n,g => case <n,g> of
+{<Sg,Masc> => scump ; <Sg,Fem> => scumpa;
+<Pl,Masc> => scumpi ; <Pl,Fem> => scumpe
+}};
+
+copula : Number => Str = table {Sg => "este" ; Pl => "sunt"};
+
+getAgrGender : NGender -> Number -> Gender = \ng,n ->
+case <ng,n> of
+{<NMasc,_> => Masc ; <NFem,_> => Fem;
+<NNeut,Sg> => Masc ; <NNeut,Pl> => Fem
+};
+
+}

testsuite/lpgf/foods/FoodsSpa.gf

@@ -0,0 +1,30 @@
+
+concrete FoodsSpa of Foods = open SyntaxSpa, StructuralSpa, ParadigmsSpa in {
+
+	lincat
+		Comment = Utt ;
+		Item = NP ;
+		Kind = CN ;
+		Quality = AP ;
+
+	lin
+		Pred item quality = mkUtt (mkCl item quality) ;
+		This kind = mkNP this_QuantSg kind ;
+		That kind = mkNP that_QuantSg kind ;
+		These kind = mkNP these_QuantPl kind ;
+		Those kind = mkNP those_QuantPl kind ;
+		Mod quality kind = mkCN quality kind ;
+		Very quality = mkAP very_AdA quality ;
+		Wine = mkCN (mkN "vino") ;
+                Pizza = mkCN (mkN "pizza") ;
+                Cheese = mkCN (mkN "queso") ;
+                Fish = mkCN (mkN "pescado") ;
+                Fresh = mkAP (mkA "fresco") ;
+                Warm = mkAP (mkA "caliente") ;
+                Italian = mkAP (mkA "italiano") ;
+                Expensive = mkAP (mkA "caro") ;
+                Delicious = mkAP (mkA "delicioso") ;
+                Boring = mkAP (mkA "aburrido") ;
+
+}
+

testsuite/lpgf/foods/FoodsSwe.gf

@@ -0,0 +1,6 @@
+
+-- (c) 2009 Aarne Ranta under LGPL
+
+concrete FoodsSwe of Foods = FoodsI with
+  (Syntax = SyntaxSwe),
+  (LexFoods = LexFoodsSwe) ** {flags language = sv_SE;} ;

testsuite/lpgf/foods/FoodsTha.gf

@@ -0,0 +1,32 @@
+
+concrete FoodsTha of Foods = open SyntaxTha, LexiconTha,
+  ParadigmsTha, (R=ResTha) in {
+
+        flags coding = utf8 ;
+
+	lincat
+		Comment = Utt ;
+		Item = NP ;
+		Kind = CN ;
+		Quality = AP ;
+
+	lin
+		Pred item quality = mkUtt (mkCl item quality) ;
+		This kind = mkNP this_Det kind ;
+		That kind = mkNP that_Det kind ;
+		These kind = mkNP these_Det kind ;
+		Those kind = mkNP those_Det kind ;
+		Mod quality kind = mkCN quality kind ;
+		Very quality = mkAP very_AdA quality ;
+		Wine = mkCN (mkN (R.thword "เหล้าอ" "งุ่น") "ขวด") ;
+                Pizza = mkCN (mkN (R.thword "พิซ" "ซา") "ถาด") ;
+                Cheese = mkCN (mkN (R.thword "เนย" "แข็ง") "ก้อน") ;
+                Fish = mkCN fish_N ;
+                Fresh = mkAP (mkA "สด") ;
+                Warm = mkAP warm_A ;
+                Italian = mkAP (mkA " อิตาลี") ;
+                Expensive = mkAP (mkA "แพง") ;
+                Delicious = mkAP (mkA "อร่อย") ;
+                Boring = mkAP (mkA (R.thword "น่า" "เบิ่อ")) ;
+
+}

testsuite/lpgf/foods/FoodsTsn.gf

@@ -0,0 +1,177 @@
+
+-- (c) 2009 Laurette Pretorius Sr & Jr and Ansu Berg under LGPL
+
+concrete FoodsTsn of Foods = open Prelude, Predef in {
+	flags coding = utf8;
+	lincat
+		Comment = {s:Str};
+		Item = {s:Str; c:NounClass; n:Number};
+		Kind = {w: Number => Str; r: Str; c: NounClass; q: Number => Str; b: Bool};
+		Quality = {s: NounClass => Number => Str; p_form: Str; t: TType};
+	lin	
+		Pred item quality = {s = item.s ++ ((mkPredDescrCop quality.t) ! item.c ! item.n) ++ quality.p_form};
+
+		This kind = {s = (kind.w ! Sg) ++ (mkDemPron1 ! kind.c ! Sg) ++ (kind.q ! Sg); c = kind.c; n = Sg};
+		That kind = {s = (kind.w ! Sg) ++ (mkDemPron2 ! kind.c ! Sg) ++ (kind.q ! Sg); c = kind.c; n = Sg};
+		These kind = {s = (kind.w ! Pl) ++ (mkDemPron1 ! kind.c ! Pl) ++ (kind.q ! Pl); c = kind.c; n = Pl};
+		Those kind = {s = (kind.w ! Pl) ++ (mkDemPron2 ! kind.c ! Pl) ++ (kind.q ! Pl); c = kind.c; n = Pl};	
+		
+		Mod quality kind = mkMod quality kind;
+
+	-- Lexicon
+		Wine = mkNounNC14_6 "jalwa";
+		Cheese = mkNounNC9_10 "kase";
+		Fish = mkNounNC9_10 "thlapi";
+		Pizza = mkNounNC9_10 "pizza";
+		Very quality = smartVery quality; 
+		Fresh = mkVarAdj "ntsha";
+		Warm = mkOrdAdj "bothitho";
+		Italian = mkPerAdj "Itali";
+		Expensive = mkVerbRel "tura"; 
+		Delicious = mkOrdAdj "monate";
+		Boring = mkOrdAdj "bosula";
+		
+	param
+		NounClass = NC9_10 | NC14_6;
+		Number = Sg | Pl;
+		TType = P | V | ModV | R ;				
+	oper
+		mkMod : {s: NounClass => Number => Str; p_form: Str; t: TType} -> {w: Number => Str; r: Str; c: NounClass; q: Number => Str; b: Bool} -> {w: Number => Str; r: Str; c: NounClass; q: Number => Str; 
+		b: Bool} = \x,y -> case y.b of
+		{
+			True => {w = y.w; r = y.r; c = y.c; 
+				q = table {
+				Sg => ((y.q ! Sg) ++ "le" ++ ((smartQualRelPart (x.t)) ! y.c ! Sg) ++ ((smartDescrCop (x.t)) ! 					y.c ! Sg) ++ (x.s ! y.c ! Sg)); 
+				Pl => ((y.q ! Pl) ++ "le" ++ ((smartQualRelPart (x.t))! y.c ! Pl) ++ ((smartDescrCop (x.t)) ! 					y.c ! Pl) ++(x.s ! y.c ! Pl))
+				  }; b = True
+				};
+			False => {w = y.w; r = y.r; c = y.c; 
+				q = table {
+				Sg => ((y.q ! Sg) ++ ((smartQualRelPart (x.t)) ! y.c ! Sg) ++ ((smartDescrCop (x.t)) ! y.c ! Sg) 					++ (x.s ! y.c ! Sg)); 
+				Pl => ((y.q ! Pl) ++ ((smartQualRelPart (x.t)) ! y.c ! Pl) ++ ((smartDescrCop (x.t)) ! y.c ! Pl) 					++(x.s ! y.c ! Pl))
+				  }; b = True
+				}
+		};
+
+		mkNounNC14_6 : Str -> {w: Number => Str; r: Str; c: NounClass; q: Number => Str; b: Bool} = \x -> {w = table {Sg => "bo" + x; Pl => "ma" + x}; r = x; c = NC14_6; 
+		q = table {Sg => ""; Pl => ""}; b = False};
+		
+		mkNounNC9_10 : Str -> {w: Number => Str; r: Str; c: NounClass; q: Number => Str; b: Bool} = \x -> {w = table {Sg => "" + x; Pl => "di" + x}; r = x; c = NC9_10; 
+		q = table {Sg => ""; Pl => ""}; b = False};
+
+		mkVarAdj : Str -> {s: NounClass => Number => Str; p_form: Str; t: TType} = \x -> 
+		{
+			s = table {
+				NC9_10 => table {Sg => "" + x; Pl => "di" + x};
+				NC14_6 => table {Sg => "bo" + x; Pl => "ma" + x}
+				};
+			p_form = x;
+			t = R;
+		};
+
+		mkOrdAdj : Str -> {s: NounClass => Number => Str; p_form: Str; t: TType} = \x -> 
+		{
+			s = table {
+				NC9_10 => table {Sg => "" + x; Pl => "" + x};
+				NC14_6 => table {Sg => "" + x; Pl => "" + x}
+				};
+			p_form = x;
+			t = R;
+		};
+
+		mkVerbRel : Str -> {s: NounClass => Number => Str; p_form: Str; t: TType} = \x -> 
+		{
+			s = table {
+				NC9_10 => table {Sg => x + "ng"; Pl => x + "ng"};
+				NC14_6 => table {Sg => x + "ng"; Pl => x + "ng"}
+				};
+			p_form = x;
+			t = V;
+		};
+
+		mkPerAdj : Str -> {s: NounClass => Number => Str; p_form: Str; t: TType} = \x -> 
+		{
+			s = table {
+				NC9_10 => table {Sg => "" + x; Pl => "" + x};
+				NC14_6 => table {Sg => "" + x; Pl => "" + x}
+				};
+			p_form = "mo" ++ x;
+			t = P;
+		};
+
+		mkVeryAdj : {s: NounClass => Number => Str; p_form: Str; t: TType} -> {s: NounClass => Number => Str; p_form: Str; t: TType} = \x ->
+		{
+			s = table{c => table{n => (x.s!c!n) ++ "thata"}}; p_form = x.p_form ++ "thata"; t = x.t
+		};
+
+		mkVeryVerb : {s: NounClass => Number => Str; p_form: Str; t: TType} -> {s: NounClass => Number => Str; p_form: Str; t: TType} = \x ->
+		{
+			s = table{c => table{n => (x.s!c!n) ++ "thata"}}; p_form = x.p_form ++ "thata"; t = ModV
+		};
+
+		smartVery : {s: NounClass => Number => Str; p_form: Str; t: TType} -> {s: NounClass => Number => Str; p_form: Str; t: TType} = 
+\x -> case x.t of --(x.s!c!n)
+		{
+			(V | ModV)	=>	mkVeryVerb x;
+			--ModV	=>	mkVeryVerb x;
+			_	=>	mkVeryAdj x
+		};
+
+		mkDemPron1 : NounClass => Number => Str = table
+			{
+				NC9_10 => table {Sg => "e"; Pl => "tse"};
+				NC14_6 => table {Sg => "bo"; Pl => "a"}
+			};
+		
+		mkDemPron2 : NounClass => Number => Str = table
+			{
+				NC9_10 => table {Sg => "eo"; Pl => "tseo"};
+				NC14_6 => table {Sg => "boo"; Pl => "ao"}
+			};
+
+		smartQualRelPart : TType -> (NounClass => Number => Str) = \x -> case x of 
+		{
+			P	=> mkQualRelPart_PName;
+			_	=> mkQualRelPart
+		};
+
+		mkQualRelPart : NounClass => Number => Str = table
+			{
+				NC9_10 => table {Sg => "e"; Pl => "tse"};
+				NC14_6 => table {Sg => "bo"; Pl => "a"}
+			};
+
+		mkQualRelPart_PName : NounClass => Number => Str = table
+			{
+				NC9_10 => table {Sg => "ya"; Pl => "tsa"};
+				NC14_6 => table {Sg => "ba"; Pl => "a"}
+			};
+
+		smartDescrCop : TType -> (NounClass => Number => Str) = \x -> case x of
+		{
+			P	=> mkDescrCop_PName;
+			_	=> mkDescrCop
+		};
+
+		mkDescrCop : NounClass => Number => Str = table
+			{
+				NC9_10 => table {Sg => "e"; Pl => "di"};
+				NC14_6 => table {Sg => "bo"; Pl => "a"}
+			};
+
+		mkDescrCop_PName : NounClass => Number => Str = table
+			{
+				NC9_10 => table {Sg => "ga"; Pl => "ga"};
+				NC14_6 => table {Sg => "ga"; Pl => "ga"}
+			};
+
+		mkPredDescrCop : TType -> (NounClass => Number => Str) = \x -> case x of
+			{
+				V => table 	{NC9_10 => table {Sg => "e" ++ "a"; Pl => "di" ++ "a"};
+						NC14_6 => table {Sg => "bo" ++ "a"; Pl => "a" ++ "a"}};
+
+				_ => table	{NC9_10 => table {Sg => "e"; Pl => "di"};
+						NC14_6 => table {Sg => "bo"; Pl => "a"}}
+			};
+
+}

testsuite/lpgf/foods/FoodsTur.gf

@@ -0,0 +1,140 @@
+{-
+  File      : FoodsTur.gf
+  Author    : Server Çimen
+  Version   : 1.0
+  Created on: August 26, 2009
+
+  This file contains concrete grammar of Foods abstract grammar for Turkish Language.
+  This grammar is to be used for Fridge demo and developed in the scope of GF Resource
+  Grammar Summer School.
+
+-}
+
+concrete FoodsTur of Foods = open Predef in {
+  flags
+    coding=utf8 ;
+  lincat
+    Comment = {s : Str} ;
+    Quality = {s : Str ; c : Case; softness : Softness; h : Harmony} ;
+    Kind = {s : Case => Number => Str} ;
+    Item = {s : Str; n : Number} ;
+  lin
+    This = det Sg "bu" ;
+    That = det Sg "şu" ;
+    These = det Pl "bu" ;
+    Those = det Pl "şu" ;
+    -- Reason for excluding plural form of copula: In Turkish if subject is not a human being,
+    -- then singular form of copula is used regardless of the number of subject. Since all
+    -- possible subjects are non human, copula do not need to have plural form.
+    Pred item quality = {s = item.s ++ quality.s ++ BIND ++ copula ! quality.softness ! quality.h} ;--! item.n} ;
+    Mod quality kind = {s = case quality.c of {
+                              Nom => \\t,n => quality.s ++ kind.s ! t ! n ;
+                              Gen => \\t,n => quality.s ++ kind.s ! Gen ! n
+                            }
+                       } ;
+    Wine = mkN "şarap" "şaraplar" "şarabı" "şarapları" ;
+    Cheese = mkN "peynir" "peynirler" "peyniri" "peynirleri" ;
+    Fish = mkN "balık" "balıklar" "balığı" "balıkları" ;
+    Pizza = mkN "pizza" "pizzalar" "pizzası" "pizzaları" ;
+    Very a = {s = "çok" ++ a.s ; c = a.c; softness = a.softness; h = a.h} ;
+    Fresh = adj "taze" Nom;
+    Warm = adj "ılık" Nom;
+    Italian = adj "İtalyan" Gen ;
+    Expensive = adj "pahalı" Nom;
+    Delicious = adj "lezzetli" Nom;
+    Boring = adj "sıkıcı" Nom;
+  param
+    Number = Sg | Pl ;
+    Case = Nom | Gen ;
+    Harmony = I_Har | Ih_Har | U_Har | Uh_Har ; --Ih = İ; Uh = Ü
+    Softness = Soft | Hard ;
+  oper
+    det : Number -> Str -> {s : Case => Number => Str} -> {s : Str; n : Number} =
+      \num,det,noun -> {s = det ++ noun.s ! Nom ! num; n = num} ;
+    mkN = overload {
+      mkN : Str -> Str -> {s : Case => Number => Str} = regNoun ;
+      mkn : Str -> Str -> Str -> Str-> {s : Case => Number => Str} = noun ;
+    } ;
+    regNoun : Str -> Str -> {s : Case => Number => Str} =
+      \peynir,peynirler -> noun peynir peynirler [] [] ;
+    noun : Str -> Str -> Str -> Str-> {s : Case => Number => Str} = 
+      \sarap,saraplar,sarabi,saraplari -> {
+        s = table {
+	      Nom =>  table {
+			Sg => sarap ;
+			Pl => saraplar
+	              } ;
+              Gen =>  table {
+                        Sg => sarabi ;
+			Pl => saraplari
+	              }
+              }
+      };
+  {-
+    Since there is a bug in overloading, this overload is useless.
+
+    mkA = overload {
+      mkA : Str -> {s : Str; c : Case; softness : Softness; h : Harmony} = \base -> adj base Nom ;
+      mkA : Str -> Case -> {s : Str; c : Case; softness : Softness; h : Harmony} = adj ;
+    } ;
+  -}
+    adj : Str -> Case -> {s : Str; c : Case; softness : Softness; h : Harmony} =
+      \italyan,ca -> {s = italyan ; c = ca; softness = (getSoftness italyan); h = (getHarmony italyan)} ;
+    -- See the comment at lines 26 and 27 for excluded plural form of copula.
+    copula : Softness => Harmony {-=> Number-} => Str =
+      table {
+        Soft => table {
+                  I_Har => "dır" ;--table {
+			   -- Sg => "dır" ;
+			   -- Pl => "dırlar"
+		  --} ;
+		  Ih_Har => "dir" ;--table {
+			    --Sg => "dir" ;
+			    --Pl => "dirler"
+		  --} ;
+		  U_Har => "dur" ;--table {
+			   -- Sg => "dur" ;
+			   -- Pl => "durlar"
+		  --} ;
+		  Uh_Har => "dür" --table {
+			    --Sg => "dür" ;
+			    --Pl => "dürler"
+		  --}
+        } ;
+        Hard => table {
+                  I_Har => "tır" ;--table {
+			    --Sg => "tır" ;
+			    --Pl => "tırlar"
+		  --} ;
+		  Ih_Har => "tir" ;--table {
+			    --Sg => "tir" ;
+			    --Pl => "tirler"
+		  --} ;
+		  U_Har => "tur" ;--table {
+			   -- Sg => "tur" ;
+			   -- Pl => "turlar"
+		  --} ;
+		  Uh_Har => "tür"--table {
+			    --Sg => "tür" ;
+			    --Pl => "türler"
+		  --}
+        }
+      } ;
+
+    getHarmony : Str -> Harmony
+      = \base -> case base of {
+                 _+c@("ı"|"a"|"i"|"e"|"u"|"o"|"ü"|"ö")+
+                 ("b"|"v"|"d"|"z"|"j"|"c"|"g"|"ğ"|"l"|"r"|"m"|"n"|"y"|"p"|"f"|"t"|"s"|"ş"|"ç"|"k"|"h")* =>
+                    case c of {
+                      ("ı"|"a") => I_Har ;
+                      ("i"|"e") => Ih_Har ;
+                      ("u"|"o") => U_Har  ;
+                      ("ü"|"ö") => Uh_Har
+                    }
+        } ;
+    getSoftness : Str -> Softness
+      = \base -> case base of {
+		   _+("f"|"s"|"t"|"k"|"ç"|"ş"|"h"|"p") => Hard ;
+		   _ => Soft
+		 } ;
+}

testsuite/lpgf/foods/FoodsUrd.gf

@@ -0,0 +1,53 @@
+-- (c) 2009 Shafqat Virk under LGPL
+
+concrete FoodsUrd of Foods = {
+
+  flags coding=utf8 ;
+
+  
+	  param Number = Sg | Pl ;
+        param Gender = Masc | Fem;
+	  
+	 oper coupla : Number -> Str =\n -> case n of {Sg => "ہے" ; Pl => "ہیں"};
+	  
+	 	  
+      lincat
+        Comment = {s : Str} ; 
+	  Item = {s: Str ; n: Number ; g:Gender};
+	  Kind = {s: Number => Str ; g:Gender};
+        Quality = {s: Gender => Number => Str};
+  
+   lin
+    Pred item quality = {s = item.s ++ quality.s ! item.g ! item.n ++  coupla item.n} ;
+	This kind = {s = "یھ" ++ kind.s ! Sg; n= Sg ; g = kind.g } ;
+	These kind = {s = "یھ" ++ kind.s ! Pl; n = Pl ; g = kind.g} ;
+    That kind = {s = "وہ"  ++ kind.s ! Sg; n= Sg ; g = kind.g} ;
+	Those kind = {s = "وہ" ++ kind.s ! Pl; n=Pl ; g = kind.g} ;
+    Mod quality kind = {s = \\n => quality.s ! kind.g ! n  ++ kind.s ! n ;  g = kind.g};
+	Wine = {s = table { Sg => "شراب" ; Pl => "شرابیں"} ; g = Fem};
+    Cheese = {s = table { Sg => "پنیر" ; Pl => "پنیریں"} ; g = Fem};
+    Fish = {s = table { Sg => "مچھلی" ; Pl => "مچھلیاں"} ; g = Fem};
+    Pizza = {s = table { Sg => "پیزہ" ; Pl => "پیزے"} ; g = Masc};
+	Very quality = {s = \\g,n => "بہت" ++ quality.s ! g ! n} ;
+    Fresh = regAdj "تازہ" ;
+    Warm = regAdj "گرم" ;
+    Italian = regAdj "اٹا لوی" ;
+    Expensive = regAdj "مہنگا" ;
+    Delicious = regAdj "مزیدار" ;
+    Boring = regAdj "فضول" ;
+   
+   oper
+    regAdj : Str -> {s: Gender => Number => Str} = \a -> case a of {
+        x + "ا" => mkAdj a (x+"ے") (x+"ی");
+        _      => mkAdj a a a
+       };
+    mkAdj : Str -> Str -> Str -> {s: Gender => Number => Str} = \s,p,f -> {
+      s = table {
+           Masc => table {
+              Sg => s;
+              Pl => p
+              };
+           Fem => \\_ => f
+         }
+       };
+	}  

testsuite/lpgf/foods/LexFoods.gf

@@ -0,0 +1,15 @@
+-- (c) 2009 Aarne Ranta under LGPL
+
+interface LexFoods = open Syntax in {
+  oper
+    wine_N : N ;
+    pizza_N : N ;
+    cheese_N : N ;
+    fish_N : N ;
+    fresh_A : A ;
+    warm_A : A ;
+    italian_A : A ;
+    expensive_A : A ;
+    delicious_A : A ;
+    boring_A : A ;
+}

testsuite/lpgf/foods/LexFoodsCat.gf

@@ -0,0 +1,18 @@
+-- (c) 2009 Jordi Saludes under LGPL
+
+instance LexFoodsCat of LexFoods = 
+    open SyntaxCat, ParadigmsCat, (M = MorphoCat) in {
+  flags
+	coding = utf8 ;
+  oper
+    wine_N = mkN "vi" "vins" M.Masc ;
+    pizza_N = mkN "pizza" ;
+    cheese_N = mkN "formatge" ;
+    fish_N = mkN "peix" "peixos" M.Masc;
+    fresh_A = mkA "fresc" "fresca" "frescos" "fresques" "frescament";
+    warm_A = mkA "calent" ;
+    italian_A = mkA "italià" "italiana" "italians" "italianes" "italianament" ;
+    expensive_A = mkA "car" ;
+    delicious_A = mkA "deliciós" "deliciosa" "deliciosos" "delicioses" "deliciosament";
+    boring_A = mkA "aburrit" "aburrida" "aburrits" "aburrides" "aburridament" ;
+}

testsuite/lpgf/foods/LexFoodsFin.gf

@@ -0,0 +1,21 @@
+-- (c) 2009 Aarne Ranta under LGPL
+--# -coding=latin1
+
+instance LexFoodsFin of LexFoods = 
+    open SyntaxFin, ParadigmsFin in {
+  oper
+    wine_N = mkN "viini" ;
+    pizza_N = mkN "pizza" ;
+    cheese_N = mkN "juusto" ;
+    fish_N = mkN "kala" ;
+    fresh_A = mkA "tuore" ;
+    warm_A = mkA 
+    (mkN "lämmin" "lämpimän" "lämmintä" "lämpimänä" "lämpimään" 
+         "lämpiminä" "lämpimiä" "lämpimien" "lämpimissä" "lämpimiin"
+	 ) 
+    "lämpimämpi" "lämpimin" ;
+    italian_A = mkA "italialainen" ;
+    expensive_A = mkA "kallis" ;
+    delicious_A = mkA "herkullinen" ;
+    boring_A = mkA "tylsä" ;
+}

testsuite/lpgf/foods/LexFoodsGer.gf

@@ -0,0 +1,17 @@
+-- (c) 2009 Aarne Ranta under LGPL
+--# -coding=latin1
+
+instance LexFoodsGer of LexFoods = 
+    open SyntaxGer, ParadigmsGer in {
+  oper
+    wine_N = mkN "Wein" ;
+    pizza_N = mkN "Pizza" "Pizzen" feminine ;
+    cheese_N = mkN "Käse" "Käse" masculine ;
+    fish_N = mkN "Fisch" ;
+    fresh_A = mkA "frisch" ;
+    warm_A = mkA "warm" "wärmer" "wärmste" ;
+    italian_A = mkA "italienisch" ;
+    expensive_A = mkA "teuer" ;
+    delicious_A = mkA "köstlich" ;
+    boring_A = mkA "langweilig" ;
+}

testsuite/lpgf/foods/LexFoodsIta.gf

@@ -0,0 +1,16 @@
+-- (c) 2009 Aarne Ranta under LGPL
+
+instance LexFoodsIta of LexFoods = 
+    open SyntaxIta, ParadigmsIta in {
+  oper
+    wine_N = mkN "vino" ;
+    pizza_N = mkN "pizza" ;
+    cheese_N = mkN "formaggio" ;
+    fish_N = mkN "pesce" ;
+    fresh_A = mkA "fresco" ;
+    warm_A = mkA "caldo" ;
+    italian_A = mkA "italiano" ;
+    expensive_A = mkA "caro" ;
+    delicious_A = mkA "delizioso" ;
+    boring_A = mkA "noioso" ;
+}

testsuite/lpgf/foods/LexFoodsLat.gf

@@ -0,0 +1,53 @@
+-- (c) 2009 Aarne Ranta under LGPL
+
+incomplete concrete LexFoodsLat of Foods = 
+  {
+  param
+    Gender = Male|Female|Neuter;
+    Number = Sg|Pl;
+  oper
+    regA : Str -> { s : Number => Gender => Str } =
+      \a -> {
+	s = case a of {
+	  stem + "us" => table { Sg => table { Male => a ;
+					       Female => stem + "a" ;
+					       Neuter => stem + "um"
+				   };
+				 Pl => table { Male => stem + "i" ;
+					       Female => stem + "ae" ;
+					       Neuter => stem + "a"
+				   }
+	    } ;
+	  _ => \\_,_ => ""
+	  }
+      } ;
+    regN : Str -> { gender : Gender ; noun : Number => Str; adj : Number => Str } =
+      \nomsg ->
+      let nounpart : { gender : Gender ; noun : Number => Str } = 
+	    case nomsg of {
+	      stem + "us" => { gender = Male; noun = table { Sg => nomsg ; Pl => stem + "i" } ; } ; 
+	      stem + "a" => { gender = Female; noun = table { Sg => nomsg ; Pl => stem + "ae" } } ; 
+	      stem + "um" => { gender = Neuter; noun = table { Sg => nomsg ; Pl => stem + "i" } } ;
+	      _ => { gender = Neuter; noun = \\_ => "" }
+	    };
+      in
+      nounpart ** { adj = \\_ => "" } ;
+    irregN : Str -> Str -> Gender -> { gender : Gender ; noun : Number => Str; adj : Number => Str } =
+      \nomsg,nompl,gender ->
+      { gender = gender ; noun = table { Sg => nomsg ; Pl => nompl } ; adj = \\_ => "" } ;
+      
+  lincat
+    Kind = { gender : Gender; noun : Number => Str; adj: Number => Str };
+    Quality = { s : Number => Gender => Str } ;
+  lin
+    Wine = regN "vinum" ;
+    Pizza = { gender = Female ; noun = table { Sg => "placenta" ; Pl => "placentae" } ; adj = table { Sg => "neapolitana" ; Pl => "neapolitanae" } } ;
+    Cheese = regN "formaticum" ;
+    Fish = irregN "piscis" "pisces" Male ;
+    Fresh = { s = table { Sg => \\_ => "recens" ; Pl => table { Male|Female => "recentes" ; Neuter => "recentia" } } } ;
+    Warm = regA "calidus" ;
+    Italian = regA "italus" ;
+    Expensive = regA "pretiosus" ;
+    Delicious = regA "iucundus" ;
+    Boring = { s = table { Sg => \\_ => "fluens" ; Pl => table { Male|Female => "fluentes" ; Neuter => "recentia" } } };
+}

testsuite/lpgf/foods/LexFoodsSwe.gf

@@ -0,0 +1,17 @@
+-- (c) 2009 Aarne Ranta under LGPL
+--# -coding=latin1
+
+instance LexFoodsSwe of LexFoods = 
+    open SyntaxSwe, ParadigmsSwe in {
+  oper
+    wine_N = mkN "vin" "vinet" "viner" "vinerna" ;
+    pizza_N = mkN "pizza" ;
+    cheese_N = mkN "ost" ;
+    fish_N = mkN "fisk" ;
+    fresh_A = mkA "färsk" ;
+    warm_A = mkA "varm" ;
+    italian_A = mkA "italiensk" ;
+    expensive_A = mkA "dyr" ;
+    delicious_A = mkA "läcker" ;
+    boring_A = mkA "tråkig" ;
+}

testsuite/lpgf/foods/MutationsGla.gf

@@ -0,0 +1,53 @@
+resource MutationsGla = open CharactersGla in {
+	param Mutation = Unmutated|Lenition1|Lenition1DNTLS|Lenition2|PrefixT|PrefixH;
+	
+	--Turns a string into a mutation table
+	oper mutate : (_ : Str) -> (Mutation => Str) = \str -> table {
+		Unmutated => str ;
+		Lenition1 => lenition1 str ;
+		Lenition1DNTLS => lenition1dntls str ;
+		Lenition2 => lenition2 str ;
+		PrefixT => prefixT str ;
+		PrefixH => prefixH str
+	};
+
+	--Performs lenition 1: inserts "h" if the word begins with a lenitable character
+	oper lenition1 : Str -> Str = \str -> case str of {
+		start@("p"|"b"|"m"|"f"|"t"|"d"|"c"|"g") + rest => start + "h" + rest ;
+		start@("P"|"B"|"M"|"F"|"T"|"D"|"C"|"G") + rest => start + "h" + rest ;
+		("s"|"S") + ("p"|"t"|"c") + _ => str ; --the sequences "sp", "st", "sc" are never mutated
+		start@("s"|"S") + rest => start + "h" + rest ;
+		_ => str
+	};
+	
+	--Performs lenition 1 with dentals: same as lenition 1 but leaves "d", "t" and "s" unmutated
+	oper lenition1dntls : Str -> Str = \str -> case str of {
+		start@("p"|"b"|"m"|"f"|"c"|"g") + rest => start + "h" + rest ;
+		start@("P"|"B"|"M"|"F"|"C"|"G") + rest => start + "h" + rest ;
+		_ => str
+	};
+
+	--Performs lenition 2: same as lenition 1 with dentals but also changes "s" into "ts"
+	oper lenition2 : Str -> Str = \str -> case str of {
+		start@("p"|"b"|"m"|"f"|"c"|"g") + rest => start + "h" + rest ;
+		start@("P"|"B"|"M"|"F"|"C"|"G") + rest => start + "h" + rest ;
+		("s"|"S") + ("p"|"t"|"c") + _ => str ; --the sequences "sp", "st", "sc" are never mutated
+		start@("s"|"S") + rest => "t-" + start + rest ;
+		_ => str
+	};
+	
+	--Prefixes a "t" to words beginning with a vowel
+	oper prefixT : Str -> Str = \str -> case str of {
+		start@(#vowel) + rest => "t-" + start + rest ;
+		start@(#vowelCap) + rest => "t-" + start + rest ;
+		_ => str
+	};
+
+	--Prefixes a "h" to words beginning with a vowel
+	oper prefixH : Str -> Str = \str -> case str of {
+		start@(#vowel) + rest => "h-" + start + rest ;
+		start@(#vowelCap) + rest => "h-" + start + rest ;
+		_ => str
+	};
+	
+}

testsuite/lpgf/foods/MutationsGle.gf

@@ -0,0 +1,92 @@
+resource MutationsGle = open CharactersGle in {
+	param Mutation = Unmutated|Lenition1|Lenition1DNTLS|Lenition2|Eclipsis1|Eclipsis2|Eclipsis3|PrefixT|PrefixH;
+	
+	--Turns a string into a mutation table
+	oper mutate : (_ : Str) -> (Mutation => Str) = \str -> table {
+		Unmutated => str ;
+		Lenition1 => lenition1 str ;
+		Lenition1DNTLS => lenition1dntls str ;
+		Lenition2 => lenition2 str ;
+		Eclipsis1 => eclipsis1 str ;
+		Eclipsis2 => eclipsis2 str ;
+		Eclipsis3 => eclipsis3 str ;
+		PrefixT => prefixT str ;
+		PrefixH => prefixH str
+	};
+
+	--Performs lenition 1: inserts "h" if the word begins with a lenitable character
+	oper lenition1 : Str -> Str = \str -> case str of {
+		start@("p"|"b"|"m"|"f"|"t"|"d"|"c"|"g") + rest => start + "h" + rest ;
+		start@("P"|"B"|"M"|"F"|"T"|"D"|"C"|"G") + rest => start + "h" + rest ;
+		("s"|"S") + ("p"|"t"|"c") + _ => str ; --the sequences "sp", "st", "sc" are never mutated
+		start@("s"|"S") + rest => start + "h" + rest ;
+		_ => str
+	};
+	
+	--Performs lenition 1 with dentals: same as lenition 1 but leaves "d", "t" and "s" unmutated
+	oper lenition1dntls : Str -> Str = \str -> case str of {
+		start@("p"|"b"|"m"|"f"|"c"|"g") + rest => start + "h" + rest ;
+		start@("P"|"B"|"M"|"F"|"C"|"G") + rest => start + "h" + rest ;
+		_ => str
+	};
+
+	--Performs lenition 2: same as lenition 1 with dentals but also changes "s" into "ts"
+	oper lenition2 : Str -> Str = \str -> case str of {
+		start@("p"|"b"|"m"|"f"|"c"|"g") + rest => start + "h" + rest ;
+		start@("P"|"B"|"M"|"F"|"C"|"G") + rest => start + "h" + rest ;
+		("s"|"S") + ("p"|"t"|"c") + _ => str ; --the sequences "sp", "st", "sc" are never mutated
+		start@("s"|"S") + rest => "t" + start + rest ;
+		_ => str
+	};
+	
+	--Performs eclisis 1: prefixes something to every word that begins with an ecliptable character
+	oper eclipsis1 : Str -> Str = \str -> case str of {
+		start@("p"|"P") + rest => "b" + start + rest ;
+		start@("b"|"B") + rest => "m" + start + rest ;
+		start@("f"|"F") + rest => "bh" + start + rest ;
+		start@("c"|"C") + rest => "g" + start + rest ;
+		start@("g"|"G") + rest => "n" + start + rest ;
+		start@("t"|"T") + rest => "d" + start + rest ;
+		start@("d"|"D") + rest => "n" + start + rest ;
+		start@(#vowel) + rest => "n-" + start + rest ;
+		start@(#vowelCap) + rest => "n" + start + rest ;
+		_ => str
+	};
+
+	--Performs eclipsis 2: same as eclipsis 1 but leaves "t", "d" and vowels unchanges
+	oper eclipsis2 : Str -> Str = \str -> case str of {
+		start@("p"|"P") + rest => "b" + start + rest ;
+		start@("b"|"B") + rest => "m" + start + rest ;
+		start@("f"|"F") + rest => "bh" + start + rest ;
+		start@("c"|"C") + rest => "g" + start + rest ;
+		start@("g"|"G") + rest => "n" + start + rest ;
+		_ => str
+	};
+
+	--Performs eclipsis 3: same as eclipsis 2 but also changes "s" to "ts"
+	eclipsis3 : Str -> Str = \str -> case str of {
+		start@("p"|"P") + rest => "b" + start + rest ;
+		start@("b"|"B") + rest => "m" + start + rest ;
+		start@("f"|"F") + rest => "bh" + start + rest ;
+		start@("c"|"C") + rest => "g" + start + rest ;
+		start@("g"|"G") + rest => "n" + start + rest ;
+		("s"|"S") + ("p"|"t"|"c") + _ => str ; --the sequences "sp", "st", "sc" are never mutated
+		start@("s"|"S") + rest => "t" + start + rest ;
+		_ => str
+	};
+
+	--Prefixes a "t" to words beginning with a vowel
+	oper prefixT : Str -> Str = \str -> case str of {
+		start@(#vowel) + rest => "t-" + start + rest ;
+		start@(#vowelCap) + rest => "t" + start + rest ;
+		_ => str
+	};
+
+	--Prefixes a "h" to words beginning with a vowel
+	oper prefixH : Str -> Str = \str -> case str of {
+		start@(#vowel) + rest => "h" + start + rest ;
+		start@(#vowelCap) + rest => "h" + start + rest ;
+		_ => str
+	};
+	
+}

testsuite/lpgf/foods/ResCze.gf

@@ -0,0 +1,46 @@
+-- (c) 2011 Katerina Bohmova under LGPL
+
+resource ResCze = open Prelude in {
+  flags 
+    coding = utf8 ;
+  param
+    Number = Sg | Pl ;
+    Gender = Masc | Fem | Neutr;
+  oper
+    NounPhrase : Type = 
+      {s : Str ; g : Gender ; n : Number} ; 
+    Noun : Type = {s : Number => Str ; g : Gender} ;
+    Adjective : Type = {s : Gender => Number => Str} ;
+
+    det : Number -> Str -> Str -> Str -> Noun -> NounPhrase =
+      \n,m,f,ne,cn -> {
+        s = table {Masc => m ; Fem => f; Neutr => ne} ! cn.g ++ 
+            cn.s ! n ;
+        g = cn.g ;
+        n = n
+      } ;
+    noun : Str -> Str -> Gender -> Noun =
+      \muz,muzi,g -> {
+        s = table {Sg => muz ; Pl => muzi} ;
+        g = g
+      } ;
+    adjective : (msg,fsg,nsg,mpl,fpl,npl : Str) -> Adjective =
+      \msg,fsg,nsg,mpl,fpl,npl -> {
+        s = table {
+          Masc => table {Sg => msg ; Pl => mpl} ; 
+          Fem => table {Sg => fsg ; Pl => fpl}  ;
+          Neutr => table {Sg => nsg ; Pl => npl}
+          }
+        } ;
+    regAdj : Str -> Adjective = 
+      \mlad ->
+      adjective (mlad+"ý") (mlad+"á") (mlad+"é")
+		 (mlad+"é") (mlad+"é") (mlad+"á") ;
+    regnfAdj : Str -> Adjective = 
+      \vynikajici ->
+      adjective vynikajici vynikajici vynikajici 
+		vynikajici vynikajici vynikajici;
+    copula : Number => Str = 
+      table {Sg => "je" ; Pl => "jsou"} ;
+}
+

testsuite/lpgf/mkTreebank.sh

@@ -0,0 +1,27 @@
+#!/usr/bin/env bash
+set -e
+if [ $# -lt 1 ]; then
+  echo "Must specify trees file"
+  exit 1
+fi
+TREES=$1
+ABSNAME="${1%.*}"
+TREEBANK="$ABSNAME.treebank"
+SCRIPT="tmp.gfs"
+
+echo "Compiling PGF"
+gf --make --output-dir="$(DIRNAME $ABSNAME)" $ABSNAME*.gf
+
+echo "Writing $SCRIPT"
+: > $SCRIPT
+while read tree; do
+  echo "linearize -treebank $tree | write_file -file=$TREEBANK -append"  >> "$SCRIPT"
+  echo "put_string \"\" | write_file -file=$TREEBANK -append"  >> "$SCRIPT"
+done < $TREES
+
+echo "Writing $TREEBANK"
+: > $TREEBANK
+gf --crun $ABSNAME.pgf < "$SCRIPT" > /dev/null
+
+echo "Removing $SCRIPT"
+rm "$SCRIPT"

testsuite/lpgf/phrasebook/Greetings.gf

@@ -0,0 +1,28 @@
+abstract Greetings = Sentences [Greeting] ** {
+
+fun
+  GBye : Greeting ;
+  GCheers : Greeting ;
+  GDamn : Greeting ;
+  GExcuse, GExcusePol : Greeting ;
+  GGoodDay : Greeting ; 
+  GGoodEvening : Greeting ;
+  GGoodMorning : Greeting ;
+  GGoodNight : Greeting ;
+  GGoodbye : Greeting ;
+  GHello  : Greeting ;
+  GHelp : Greeting ;
+  GHowAreYou : Greeting ;
+  GLookOut : Greeting ;
+  GNiceToMeetYou : Greeting ;
+  GPleaseGive, GPleaseGivePol : Greeting ;
+  GSeeYouSoon : Greeting ;
+  GSorry, GSorryPol : Greeting ;
+  GThanks : Greeting ;
+  GTheCheck : Greeting ;
+  GCongratulations : Greeting ;
+  GHappyBirthday : Greeting ;
+  GGoodLuck : Greeting ; 
+  GWhatTime : Greeting ;
+
+}

testsuite/lpgf/phrasebook/GreetingsBul.gf

@@ -0,0 +1,31 @@
+concrete GreetingsBul of Greetings = SentencesBul [Greeting,mkGreeting] ** open Prelude in {
+
+flags
+  coding=utf8;
+
+lin 
+  GBye = mkGreeting "чао" ;
+  GCheers = mkGreeting "наздраве" ;
+  GDamn = mkGreeting "по дяволите" ;
+  GExcuse, GExcusePol = mkGreeting "извинете" ;
+  GGoodDay = mkGreeting "добър ден" ;
+  GGoodEvening = mkGreeting "добра вечер" ;
+  GGoodMorning = mkGreeting "добро утро" ;
+  GGoodNight = mkGreeting "лека нощ" ;
+  GGoodbye = mkGreeting "довиждане" ;
+  GHello = mkGreeting "здравей" ;
+  GHelp = mkGreeting "помощ" ;
+  GHowAreYou = mkGreeting "как си" ;
+  GLookOut = mkGreeting "погледни" ;
+  GNiceToMeetYou = mkGreeting "радвам се да се видим" ;
+  GPleaseGive, GPleaseGivePol = mkGreeting "моля" ;
+  GSeeYouSoon = mkGreeting "до скоро" ;
+  GSorry, GSorryPol = mkGreeting "извинете" ;
+  GThanks = mkGreeting "благодаря ти" ;
+  GTheCheck = mkGreeting "сметката" ;
+  GCongratulations = mkGreeting "поздравления";
+  GHappyBirthday = mkGreeting "честит рожден ден" ;
+  GGoodLuck = mkGreeting "успех" ; 
+  GWhatTime = mkGreeting "колко е часът" ;
+
+}

testsuite/lpgf/phrasebook/GreetingsCat.gf

@@ -0,0 +1,31 @@
+--# -coding=latin1
+concrete GreetingsCat of Greetings = SentencesCat [Greeting,mkGreeting] ** open Prelude in {
+
+lin 
+  GBye = mkGreeting "adéu" ;
+  GCheers = mkGreeting "salut" ;
+  GDamn = mkGreeting "merda" ;
+  GExcuse = mkGreeting "perdona" ;
+  GExcusePol = mkGreeting ("perdoni" | "disculpi") ;
+  GCongratulations = mkGreeting "felicitats" ;
+  GHappyBirthday = mkGreeting "feliç aniversari" ;
+  GGoodLuck = mkGreeting "sort" ;
+  GGoodDay = mkGreeting "bon dia" ;
+  GGoodEvening = mkGreeting "bona tarda" ;
+  GGoodMorning = mkGreeting "bon dia" ;
+  GGoodNight = mkGreeting "bona nit" ;
+  GGoodbye = mkGreeting "a reveure" ;
+  GHello = mkGreeting "hola" ;
+  GHelp = mkGreeting "socors" ;
+  GHowAreYou = mkGreeting "què tal" ;
+  GLookOut = mkGreeting "compte" ;
+  GNiceToMeetYou = mkGreeting "encantat de conèixer-lo" ; -- make distinction Masc/Fem
+  GPleaseGive = mkGreeting "si et plau" ;
+  GPleaseGivePol = mkGreeting "si us plau" ;
+  GSeeYouSoon = mkGreeting "fins aviat" ; 
+  GSorry = mkGreeting "perdoni" ;
+  GSorryPol = mkGreeting "em sap greu" ; 
+  GThanks = mkGreeting "gràcies" ;
+  GTheCheck = mkGreeting "el compte" ;
+
+}

testsuite/lpgf/phrasebook/GreetingsChi.gf

@@ -0,0 +1,33 @@
+concrete GreetingsChi of Greetings =
+SentencesChi [Greeting,mkGreeting] **
+open ParadigmsChi, ResChi, Prelude in {
+
+flags coding = utf8 ;
+
+lin
+GBye = (mkInterj "再见" ) ;
+GCheers = (mkInterj "干杯" ) ;
+GDamn = (mkInterj "该死的" ) ;
+GExcuse, GExcusePol = (mkInterj "原谅我" ) ;
+GGoodDay = (mkInterj "你好" ) ;
+GGoodEvening = (mkInterj "下午好" ) ;
+GGoodMorning = (mkInterj "早上好" ) ;
+GGoodNight = (mkInterj "晚安" ) ;
+GGoodbye = (mkInterj "再见" ) ;
+GHello = (mkInterj "你好" ) ;
+GHelp = mkInterj "帮助" ;
+GHowAreYou = mkInterj "你好吗" ;
+GLookOut = mkInterj "留意" ;
+GNiceToMeetYou = mkInterj "很高兴见到你" ;
+GNiceToMeetYouPol = mkInterj "很高兴见到您" ;
+GPleaseGive, GPleaseGivePol = mkInterj "请" ;
+GSeeYouSoon = mkInterj "很快再见" ;
+GSorry, GSorryPol = mkInterj "对不起" ;
+GThanks = (mkInterj "谢谢" ) ;
+GTheCheck = mkInterj "检查" ;
+GCongratulations = mkInterj "祝贺您" ;
+GHappyBirthday = mkInterj "祝你生日快乐" ;
+GGoodLuck = (mkInterj "祝你好运" ) ;
+GWhatTime = mkInterj "现在是什么时候" ;
+
+}

testsuite/lpgf/phrasebook/GreetingsDan.gf

@@ -0,0 +1,29 @@
+--# -coding=latin1
+concrete GreetingsDan of Greetings = SentencesDan [Greeting,mkGreeting] ** open Prelude in {
+
+lin 
+  GBye = mkGreeting "hej hej" ; -- not google translate
+  GCheers = mkGreeting "skål" ;
+  GDamn = mkGreeting "satans" ; -- X  
+  GExcuse, GExcusePol = mkGreeting "undskyld mig" ;
+  GGoodDay = mkGreeting "god dag" ;
+  GGoodEvening = mkGreeting "god aften" ;
+  GGoodMorning = mkGreeting "god morgen" ;
+  GGoodNight = mkGreeting "godnat" ;
+  GGoodbye = mkGreeting "farvel" ;
+  GHello = mkGreeting "hej" ;
+  GHelp = mkGreeting "hjælp" ;
+  GHowAreYou = mkGreeting "hvordan har du det" ;
+  GLookOut = mkGreeting "pas på" ;
+  GNiceToMeetYou, GNiceToMeetYouPol = mkGreeting "hyggeligt at møde dig" ; -- more common than rart (google translate) 
+  GPleaseGive = mkGreeting "vær så sød" ; -- can also have flink instead of sod
+  GPleaseGivePol = mkGreeting "venligst" ; -- X not behage 
+  GSeeYouSoon = mkGreeting "vi ses snart" ; -- X se dig snart
+  GSorry, GSorryPol = mkGreeting "undskyld" ;
+  GThanks = mkGreeting "tak" ;
+  GTheCheck = mkGreeting "regningen" ;
+  GCongratulations = mkGreeting "tillykke";
+  GHappyBirthday = mkGreeting "tillykke med fødselsdagen" ;
+  GGoodLuck = mkGreeting "held og lykke" ; 
+
+}

testsuite/lpgf/phrasebook/GreetingsDut.gf

@@ -0,0 +1,30 @@
+concrete GreetingsDut of Greetings = SentencesDut [Greeting,mkGreeting] ** open Prelude in {
+
+
+lin 
+  GBye = mkGreeting "doei" ; 
+  GCheers = mkGreeting "proost" ;
+  GDamn = mkGreeting "verdomme" ; 
+  GExcuse, GExcusePol = mkGreeting "pardon" ; 
+  GGoodDay = mkGreeting "goedendag" ;
+  GGoodEvening = mkGreeting "goedenavond" ;
+  GGoodMorning = mkGreeting "goedemorgen" ;
+  GGoodNight = mkGreeting "goedenacht" ;
+  GGoodbye = mkGreeting "tot ziens" ;
+  GHello = mkGreeting "hallo" ;
+  GHelp = mkGreeting "help" ;
+  GHowAreYou = mkGreeting "hoe gaat het" ;
+  GLookOut = mkGreeting "kijk uit" ;
+  GNiceToMeetYou = mkGreeting "leuk je te ontmoeten" ;
+  GNiceToMeetYouPol = mkGreeting "leuk je u ontmoeten" ;
+  GPleaseGive, GPleaseGivePol = mkGreeting "alstublieft" ; 
+  GSeeYouSoon = mkGreeting "tot ziens" ;
+  GSorry = mkGreeting "sorry";
+  GSorryPol = mkGreeting "mijn verontschuldiging" ;
+  GThanks = mkGreeting "dank je wel" ; 
+  GTheCheck = mkGreeting "rekening" ; 
+  GCongratulations = mkGreeting "gefeliciteerd";
+  GHappyBirthday = mkGreeting "gelukkige verjaardag" ;
+  GGoodLuck = mkGreeting "veel geluk" ; 
+  GWhatTime = mkGreeting "hoe laat is het" ;
+}

testsuite/lpgf/phrasebook/GreetingsEng.gf

@@ -0,0 +1,27 @@
+concrete GreetingsEng of Greetings = SentencesEng [Greeting,mkGreeting] ** open Prelude in {
+
+lin 
+  GBye = mkGreeting "bye" ;
+  GCheers = mkGreeting "cheers" ;
+  GDamn = mkGreeting "damn" ;
+  GExcuse, GExcusePol = mkGreeting "excuse me" ;
+  GGoodDay = mkGreeting "good afternoon" ; ----
+  GGoodEvening = mkGreeting "good evening" ;
+  GGoodMorning = mkGreeting "good morning" ;
+  GGoodNight = mkGreeting "good night" ;
+  GGoodbye = mkGreeting "goodbye" ;
+  GHello = mkGreeting "hello" ;
+  GHelp = mkGreeting "help" ;
+  GHowAreYou = mkGreeting "how are you" ;
+  GLookOut = mkGreeting "look out" ;
+  GNiceToMeetYou, GNiceToMeetYouPol = mkGreeting "nice to meet you" ;
+  GPleaseGive, GPleaseGivePol = mkGreeting "please" ;
+  GSeeYouSoon = mkGreeting "see you soon" ;
+  GSorry, GSorryPol = mkGreeting "sorry" ;
+  GThanks = mkGreeting "thank you" ;
+  GTheCheck = mkGreeting "the bill" ;
+  GCongratulations = mkGreeting "congratulations";
+  GHappyBirthday = mkGreeting "happy birthday" ;
+  GGoodLuck = mkGreeting "good luck" ; 
+  GWhatTime = mkGreeting "what time is it" | mkGreeting "what is the time" ;
+}

testsuite/lpgf/phrasebook/GreetingsEst.gf

@@ -0,0 +1,26 @@
+concrete GreetingsEst of Greetings = SentencesEst [Greeting,mkGreeting] ** open Prelude in {
+
+lin
+  GBye = mkGreeting "head aega" ;
+  GCheers = mkGreeting "terviseks" ;
+  GDamn = mkGreeting "neetud" ;
+  GExcuse, GExcusePol = mkGreeting "vabandust" ;
+  GGoodDay = mkGreeting "tere päevast" ;
+  GGoodEvening = mkGreeting "tere õhtust" ;
+  GGoodMorning = mkGreeting "tere hommikust" ;
+  GGoodNight = mkGreeting "head ööd" ;
+  GGoodbye = mkGreeting "head aega" ;
+  GHello = mkGreeting "tere" ;
+  GHelp = mkGreeting "appi" ;
+  GHowAreYou = mkGreeting "kuidas käsi käib" ;
+  GLookOut = mkGreeting "ettevaatust" ;
+  GNiceToMeetYou = mkGreeting "meeldiv tutvuda" ;
+  GPleaseGive, GPleaseGivePol = mkGreeting "palun" ;
+  GSeeYouSoon = mkGreeting "kohtumiseni" ;
+  GSorry, GSorryPol = mkGreeting "vabandust" ;
+  GThanks = mkGreeting "suur tänu" ;
+  GTheCheck = mkGreeting "arve" ;
+  GCongratulations = mkGreeting "palju õnne";
+  GHappyBirthday = mkGreeting "palju õnne sünnipäevaks" ;
+  GGoodLuck = mkGreeting "palju edu" ;
+}

testsuite/lpgf/phrasebook/GreetingsFin.gf

@@ -0,0 +1,30 @@
+--# -coding=latin1
+concrete GreetingsFin of Greetings = SentencesFin [Greeting,mkGreeting] ** open Prelude in {
+
+lin 
+  GBye = mkGreeting "hei hei" ;
+  GCheers = mkGreeting "terveydeksi" ;
+  GDamn = mkGreeting "hitto" ;
+  GExcuse, GExcusePol = mkGreeting "anteeksi" ;
+  GGoodDay = mkGreeting "hyvää päivää" ;
+  GGoodEvening = mkGreeting "hyvää iltaa" ;
+  GGoodMorning = mkGreeting "hyvää huomenta" ;
+  GGoodNight = mkGreeting "hyvää yötä" ;
+  GGoodbye = mkGreeting "näkemiin" ;
+  GHello = mkGreeting "hei" ;
+  GHelp = mkGreeting "apua" ;
+  GHowAreYou = mkGreeting "mitä kuuluu" ;
+  GLookOut = mkGreeting "varo" ;
+  GNiceToMeetYou = mkGreeting "hauska tutustua" ;
+  GPleaseGive = mkGreeting "ole hyvä" ;
+  GPleaseGivePol = mkGreeting "olkaa hyvä" ;
+  GSeeYouSoon = mkGreeting "nähdään pian" ;
+  GSorry, GSorryPol = mkGreeting "anteeksi" ;
+  GThanks = mkGreeting "kiitos" ;
+  GTheCheck = mkGreeting "lasku" ;
+  GCongratulations = mkGreeting "onnittelut";
+  GHappyBirthday = mkGreeting "hyvää syntymäpäivää" ;
+  GGoodLuck = mkGreeting "onnea" ; 
+  GWhatTime = mkGreeting "paljonko kello on" | mkGreeting "mitä kello on" ;
+
+}

testsuite/lpgf/phrasebook/GreetingsFre.gf

@@ -0,0 +1,31 @@
+--# -coding=latin1
+concrete GreetingsFre of Greetings = SentencesFre [Greeting,mkGreeting] ** open Prelude in {
+
+lin 
+  GBye = mkGreeting "au revoir" ;
+  GCheers = mkGreeting "santé" ;
+  GDamn = mkGreeting "maudit" ;
+  GExcuse = mkGreeting "excuse-moi" ;
+  GExcusePol = mkGreeting "excusez-moi" ;
+  GGoodDay = mkGreeting "bonjour" ;
+  GGoodEvening = mkGreeting "bon soir" ;
+  GGoodMorning = mkGreeting "bonjour" ;
+  GGoodNight = mkGreeting "bonne nuit" ;
+  GGoodbye = mkGreeting "au revoir" ;
+  GHello = mkGreeting "salut" ;
+  GHelp = mkGreeting "au secours" ;
+  GHowAreYou = mkGreeting "comment ça va" ;
+  GLookOut = mkGreeting "attention" ;
+  GNiceToMeetYou = mkGreeting "enchanté" ;
+  GPleaseGive = mkGreeting "s'il te plaît" ;
+  GPleaseGivePol = mkGreeting "s'il vous plaît" ;
+  GSeeYouSoon = mkGreeting "à bientôt" ;
+  GSorry, GSorryPol = mkGreeting "pardon" ;
+  GThanks = mkGreeting "merci" ;
+  GTheCheck = mkGreeting "l'addition" ;
+  GCongratulations = mkGreeting "félicitations";
+  GHappyBirthday = mkGreeting "joyeux anniversaire" ;
+  GGoodLuck = mkGreeting "bonne chance" ; 
+  GWhatTime = mkGreeting "quelle heure est-il" ;
+
+}

testsuite/lpgf/phrasebook/GreetingsGer.gf

@@ -0,0 +1,31 @@
+--# -path=.:abstract:prelude:german:api:common
+--# -coding=latin1
+concrete GreetingsGer of Greetings = SentencesGer [Greeting,mkGreeting] ** open Prelude in {
+
+lin 
+  GBye = mkGreeting "tschüß" ;
+  GCheers = mkGreeting "zum Wohl" ;
+  GDamn = mkGreeting "verdammt" ;
+  GExcuse, GExcusePol = mkGreeting "Entschuldigung" ;
+  GGoodDay = mkGreeting "guten Tag" ;
+  GGoodEvening = mkGreeting "guten Abend" ;
+  GGoodMorning = mkGreeting "guten Morgen" ;
+  GGoodNight = mkGreeting "gute Nacht" ;
+  GGoodbye = mkGreeting "auf Wiedersehen" ;
+  GHello = mkGreeting "Hallo" ;
+  GHelp = mkGreeting "Hilfe" ;
+  GHowAreYou = mkGreeting "wie geht's" ;
+  GLookOut = mkGreeting "Achtung" ;
+  GNiceToMeetYou = mkGreeting "nett, Sie zu treffen" ;
+  GPleaseGive, GPleaseGivePol = mkGreeting "bitte" ;
+  GSeeYouSoon = mkGreeting "bis bald" ;
+  GSorry, GSorryPol = mkGreeting "Entschuldigung" ;
+  GThanks = mkGreeting "Danke" ;
+  GTheCheck = mkGreeting "die Rechnung" ;
+  GCongratulations = mkGreeting "herzlichen Glückwunsch";
+  GHappyBirthday = mkGreeting "alles Gute zum Geburtstag" ;
+  GGoodLuck = mkGreeting "viel Glück" ; 
+  GWhatTime = mkGreeting "wieviel Uhr ist es" | mkGreeting "wie spät ist es" ;
+
+}
+

testsuite/lpgf/phrasebook/GreetingsHin.gf

@@ -0,0 +1,31 @@
+concrete GreetingsHin of Greetings = SentencesHin [Greeting,mkGreeting] ** open (P=Prelude) in {
+
+-- lincat 
+--  Greeting = {s : Str; lock_Text : {}} ;
+flags coding = utf8 ;
+lin 
+  GBye = P.ss "नमस्कार" ;
+  GCheers = P.ss "चियर्ज़" ;
+  GDamn = P.ss "ाफ़" ;
+  GExcuse, GExcusePol = P.ss "क्षमा कीजिये" ;
+  GGoodDay = P.ss "नमस्कार" ; ----
+  GGoodEvening = P.ss "नमस्कार" ;
+  GGoodMorning = P.ss "नमस्कार" ;
+  GGoodNight = P.ss "नमस्कार" ;
+  GGoodbye = P.ss "हम आपसे विदा लेते हैं" ;
+  GHello = P.ss "नमस्कार" ;
+  GHelp = P.ss "सहायता" ;
+  GHowAreYou = P.ss "आप कैसे हैं" ;
+  GLookOut = P.ss "सावधान" ;
+  GNiceToMeetYou, GNiceToMeetYouPol = P.ss "आप से मिल कर च्छा लगा" ;
+  GPleaseGive, GPleaseGivePol = P.ss "कृपया" ;
+  GSeeYouSoon = P.ss "फिर मिलेंगे" ;
+  GSorry, GSorryPol = P.ss "क्षमा कीजिये" ;
+  GThanks = P.ss "धन्यवाद" ;
+  GTheCheck = P.ss "बिल" ;
+  GCongratulations = P.ss "बधाई हो";
+  GHappyBirthday = P.ss "जन्मदिन की शुभकामनाएँ" ;
+  GGoodLuck = P.ss "शुभकामनाएँ" ; 
+  GWhatTime = P.ss "कितने बजे हैं" ;
+
+}

testsuite/lpgf/phrasebook/GreetingsIta.gf

@@ -0,0 +1,31 @@
+concrete GreetingsIta of Greetings = SentencesIta [Greeting,mkGreeting] ** open Prelude in {
+
+lin 
+  GBye = mkGreeting "ciao" ;
+  GCheers = mkGreeting "cincin" ;
+  GDamn = mkGreeting "maledizione" ;
+  GExcuse = mkGreeting "scusa" ;
+  GExcusePol = mkGreeting "scusi" ;
+  GGoodDay = mkGreeting "buongiorno" ;
+  GGoodEvening = mkGreeting "buona sera" ;
+  GGoodMorning = mkGreeting "buongiorno" ;
+  GGoodNight = mkGreeting "buona notte" ;
+  GGoodbye = mkGreeting "arrivederci" ;
+  GHello = mkGreeting "ciao" ;
+  GHelp = mkGreeting "aiuto" ;
+  GHowAreYou = mkGreeting "come sta" ;
+  GLookOut = mkGreeting "attenzione" ;
+  GNiceToMeetYou = mkGreeting "piacere di conoscerti" ;
+  GNiceToMeetYouPol = mkGreeting "piacere di conoscerLa" ;
+  GPleaseGive, GPleaseGivePol = mkGreeting "per favore" ;
+  GSeeYouSoon = mkGreeting "a presto" ; ----
+  GSorry = mkGreeting "scusami" ; ----
+  GSorryPol = mkGreeting "scusimi" ; ----
+  GThanks = mkGreeting "grazie" ;
+  GTheCheck = mkGreeting "il conto" ;
+  GCongratulations = mkGreeting "congratulazioni";
+  GHappyBirthday = mkGreeting "buon compleanno" ;
+  GGoodLuck = mkGreeting "buona fortuna" ; 
+  GWhatTime = mkGreeting "che ore sono" ;
+
+}

testsuite/lpgf/phrasebook/GreetingsJpn.gf

@@ -0,0 +1,30 @@
+concrete GreetingsJpn of Greetings = SentencesJpn [Greeting,mkGreeting] ** open Prelude in {
+
+flags coding = utf8 ;
+
+lin 
+  GBye = mkGreeting "バイ" ;
+  GCheers = mkGreeting "かんぱい" ;
+  GDamn = mkGreeting "くそ" ;
+  GExcuse, GExcusePol = mkGreeting "すみません" ;
+  GGoodDay, GHello = mkGreeting "こんにちは" ; ----
+  GGoodEvening = mkGreeting "こんばんは" ;
+  GGoodMorning = mkGreeting "おはようございます" ;
+  GGoodNight = mkGreeting "おやすみなさい" ;
+  GGoodbye = mkGreeting "さようなら" ;
+  GHelp = mkGreeting "助けて" ;
+  GHowAreYou = mkGreeting "お元気ですか" ;
+  GLookOut = mkGreeting "危ない" ;
+  GNiceToMeetYou = mkGreeting "初めまして" ;
+  GPleaseGive = mkGreeting "ください" ;
+  GPleaseGivePol = mkGreeting "お願いします" ;
+  GSeeYouSoon = mkGreeting "またね" ;
+  GSorry = mkGreeting "ごめんなさい" ;
+  GSorryPol = mkGreeting "申し訳ありません" ;
+  GThanks = mkGreeting "ありがとう" ;
+  GTheCheck = mkGreeting "会計" ;
+  GCongratulations = mkGreeting "お目出度うご座います";
+  GHappyBirthday = mkGreeting "お誕生日おめでとうございます" ;
+  GGoodLuck = mkGreeting "がんばってください" ; 
+  GWhatTime = mkGreeting "今何時ですか" ;
+}

testsuite/lpgf/phrasebook/GreetingsLav.gf

@@ -0,0 +1,33 @@
+--# -path=.:present
+concrete GreetingsLav of Greetings = SentencesLav [Greeting, mkGreeting] **
+open Prelude 
+in {
+
+	flags
+		coding = utf8 ;
+
+	lin
+		GBye = mkGreeting "atā" ;
+		GCheers = mkGreeting "priekā" ;
+		GDamn = mkGreeting "sasodīts" ;
+		GExcuse, GExcusePol = mkGreeting "atvainojiet" ;
+		GGoodDay = mkGreeting "labdien" ;
+		GGoodEvening = mkGreeting "labvakar" ;
+		GGoodMorning = mkGreeting "labrīt" ;
+		GGoodNight = mkGreeting "ar labunakti" ;
+		GGoodbye = mkGreeting "visu labu" ;
+		GHello = mkGreeting "sveiki" ;
+		GHelp = mkGreeting "palīdziet" ;
+		GHowAreYou = mkGreeting "kā klājas" ;
+		GLookOut = mkGreeting "uzmanīgi" ;
+		GNiceToMeetYou, GNiceToMeetYouPol = mkGreeting "prieks iepazīties" ;
+		GPleaseGive, GPleaseGivePol = mkGreeting "lūdzu" ;
+		GSeeYouSoon = mkGreeting "uz drīzu tikšanos" ;
+		GSorry, GSorryPol = mkGreeting "piedodiet" ;
+		GThanks = mkGreeting "paldies" ;
+		GTheCheck = mkGreeting "rēķins" ;
+		GCongratulations = mkGreeting "apsveicu" ;
+		GHappyBirthday = mkGreeting "daudz laimes dzimšanas dienā" ;
+		GGoodLuck = mkGreeting "veiksmīgi" ;
+
+}

testsuite/lpgf/phrasebook/GreetingsNor.gf

@@ -0,0 +1,28 @@
+--# -coding=latin1
+concrete GreetingsNor of Greetings = SentencesNor [Greeting,mkGreeting] ** open Prelude in {
+
+lin 
+  GBye = mkGreeting "ha det" ;
+  GCheers = mkGreeting "skål" ; -- google translate ! 
+  GDamn = mkGreeting "faen" ; 
+  GExcuse, GExcusePol = mkGreeting "unnskyld" ;
+  GGoodDay = mkGreeting "god dag" ;
+  GGoodEvening = mkGreeting "god kveld" ;
+  GGoodMorning = mkGreeting "god morgen" ;
+  GGoodNight = mkGreeting "god natt" ;
+  GGoodbye = mkGreeting "ha det bra" ;
+  GHello = mkGreeting "hei" ;
+  GHelp = mkGreeting "hjelp" ;
+  GHowAreYou = mkGreeting "hvordan går det" ;
+  GLookOut = mkGreeting "se opp" ; -- google translate !
+  GNiceToMeetYou, GNiceToMeetYouPol = mkGreeting "hyggelig å treffe deg" ;
+  GPleaseGive, GPleaseGivePol = mkGreeting "vær så snill" ;
+  GSeeYouSoon = mkGreeting "se deg snart" ; -- google translate !
+  GSorry, GSorryPol = mkGreeting "beklager" ;
+  GThanks = mkGreeting "takk" ;
+  GTheCheck = mkGreeting "regningen" ;
+  GCongratulations = mkGreeting "gratulerer";
+  GHappyBirthday = mkGreeting "gratulerer med dagen" ;
+  GGoodLuck = mkGreeting "lykke til" ; 
+
+}

testsuite/lpgf/phrasebook/GreetingsPes.gf

@@ -0,0 +1,29 @@
+concrete GreetingsPes of Greetings = SentencesPes [mkGreeting] ** open (P=Prelude) in {
+
+-- lincat 
+--  Greeting = {s : Str; lock_Text : {}} ;
+flags coding = utf8 ;
+lin 
+  GBye = P.ss ["خداحافظ"] ;
+  GCheers = P.ss ["به سلامتی"] ; 
+  GDamn = P.ss "لعنتی" ;
+  GExcuse, GExcusePol = P.ss ["ببخشید"] ;
+  GGoodDay = P.ss ["روز به خیر"] ; ----
+  GGoodEvening = P.ss ["عصر به خیر"] ;
+  GGoodMorning = P.ss ["صبح به خیر"] ;
+  GGoodNight = P.ss ["شب به خیر"] ;
+  GGoodbye = P.ss ["خداحافظ"] ;
+  GHello = P.ss "سلام" ;
+  GHelp = P.ss "کمک" ;
+  GHowAreYou = P.ss ["حال شما چطور است"] ;
+  GLookOut = P.ss ["مراقب باشید"] ;
+  GNiceToMeetYou, GNiceToMeetYouPol = P.ss ["از ملاقات شما خوشوقتم"] ;
+  GPleaseGive, GPleaseGivePol = P.ss ["لطفاً بدهید"] ;
+  GSeeYouSoon = P.ss ["به امید دیدار"] ;
+  GSorry, GSorryPol = P.ss "متأسفم" ;
+  GThanks = P.ss "ممنونم" ;
+  GTheCheck = P.ss "چک" ;
+  GCongratulations = P.ss ["تبریک میگم"];
+  GHappyBirthday = P.ss ["تولدت مبارک"] ;
+  GGoodLuck = P.ss ["موفق باشید"] ; 
+}

testsuite/lpgf/phrasebook/GreetingsPol.gf

@@ -0,0 +1,27 @@
+concrete GreetingsPol of Greetings = SentencesPol [Greeting,mkGreeting] ** open Prelude in {
+
+flags
+  optimize =values ; coding =utf8 ; 
+
+lin 
+  GBye = mkGreeting "cześć" ;
+  GCheers = mkGreeting "na zdrowie" ;
+  GDamn = mkGreeting "cholera" ; -- not polite
+  GExcuse, GExcusePol, GSorry, GSorryPol = mkGreeting "przepraszam" ;
+  GGoodDay, GGoodMorning = mkGreeting "dzień dobry" ;
+  GGoodEvening = mkGreeting "dobry wieczór" ;
+  GGoodNight = mkGreeting "dobranoc" ;
+  GGoodbye = mkGreeting "do widzenia" ;
+  GHello = mkGreeting "cześć" ;
+  GHelp = mkGreeting "pomocy" ;
+  GHowAreYou = mkGreeting "jak się masz" ;
+  GLookOut = mkGreeting "uwaga" ;
+  GNiceToMeetYou = mkGreeting "miło mi" ; 
+  GPleaseGive, GPleaseGivePol = mkGreeting "poproszę" ;
+  GSeeYouSoon = mkGreeting "do zobaczenia" ;
+  GThanks = mkGreeting "dziękuję" ;
+  GTheCheck = mkGreeting "rachunek" ;
+  GCongratulations = mkGreeting "gratulacje";
+  GHappyBirthday = mkGreeting "wszystkiego najlepszego z okazji urodzin" ;
+  GGoodLuck = mkGreeting "powodzenia" ; 
+}

testsuite/lpgf/phrasebook/GreetingsRon.gf

@@ -0,0 +1,31 @@
+concrete GreetingsRon of Greetings = SentencesRon [Greeting,mkGreeting] ** open Prelude in {
+
+flags coding = utf8 ;
+
+lin 
+  GBye = mkGreeting "pa" ;
+  GCheers = mkGreeting "noroc" ;
+  GDamn = mkGreeting "ptiu" ;
+  GExcuse = mkGreeting "pardon" ;
+  GExcusePol = mkGreeting "mă scuzați" ;
+  GGoodDay = mkGreeting "bună ziua" ;
+  GGoodEvening = mkGreeting "bună seara" ;
+  GGoodMorning = mkGreeting "bună dimineaţa" ;
+  GGoodNight = mkGreeting "noapte bună" ;
+  GGoodbye = mkGreeting "la revedere" ;
+  GHello = mkGreeting "salut" ;
+  GHelp = mkGreeting "ajutor" ;
+  GHowAreYou = mkGreeting "ce faci" ;
+  GLookOut = mkGreeting "atenţie" ;
+  GNiceToMeetYou = mkGreeting "încântat" ;
+  GPleaseGive = mkGreeting "te rog" ;
+  GPleaseGivePol = mkGreeting "vă rog" ;
+  GSeeYouSoon = mkGreeting "pe curând" ;
+  GSorry, GSorryPol = mkGreeting "îmi pare rău" ;
+  GThanks = mkGreeting "mulţumesc" ;
+  GTheCheck = mkGreeting "nota de plată" ;
+  GCongratulations = mkGreeting "felicitări";
+  GHappyBirthday = mkGreeting "la mulți ani" ;
+  GGoodLuck = mkGreeting "baftă" ; 
+
+}

testsuite/lpgf/phrasebook/GreetingsRus.gf

@@ -0,0 +1,29 @@
+concrete GreetingsRus of Greetings = open Prelude in {
+
+flags coding = utf8 ;
+
+lin 
+  GBye = ss "до свидания" ;
+  GCheers = ss "ура" ;
+  GDamn = ss "чёрт" ;
+  GExcuse, GExcusePol = ss "извините" ;
+  GGoodDay = ss "добрый день" ; ----
+  GGoodEvening = ss "добрый вечер" ;
+  GGoodMorning = ss "доброе утро" ;
+  GGoodNight = ss "спокойной ночи" ;
+  GGoodbye = ss "до свидания" ;
+  GHello = ss "привет" ;
+  GHelp = ss "помогите" ;
+  GHowAreYou = ss "Как поживаете" ;
+  GLookOut = ss "смотреть" ;
+  GNiceToMeetYou, GNiceToMeetYouPol = ss "приятно познакомиться" ;
+  GPleaseGive, GPleaseGivePol = ss "пожалуйста" ;
+  GSeeYouSoon = ss "до скорой встречи" ;
+  GSorry, GSorryPol = ss "Мне жаль" ;
+  GThanks = ss "спасибо" ;
+  GTheCheck = ss "проверить" ;
+  GCongratulations = ss "поздравляю";
+  GHappyBirthday = ss "с днем рождения" ;
+  GGoodLuck = ss "желаю удачи" ; 
+
+}

testsuite/lpgf/phrasebook/GreetingsSnd.gf

@@ -0,0 +1,29 @@
+concrete GreetingsSnd of Greetings = SentencesSnd [mkGreeting,Greeting] ** open (P=Prelude) in {
+
+-- lincat 
+--  Greeting = {s : Str; lock_Text : {}} ;
+flags coding = utf8 ;
+lin 
+  GBye = P.ss "خدا حافظ" ;
+  GCheers = P.ss "چيئرز" ;
+  GDamn = P.ss "اف" ;
+  GExcuse, GExcusePol = P.ss "معاف ڪجو" ;
+  GGoodDay = P.ss "ڏينهن بخير" ; ----
+  GGoodEvening = P.ss "شام بخير" ;
+  GGoodMorning = P.ss "صبح بخير" ;
+  GGoodNight = P.ss "رات بخير" ;
+  GGoodbye = P.ss "خدا حافظ" ;
+  GHello = P.ss "السلام عليڪم" ;
+  GHelp = P.ss "مدد" ;
+  GHowAreYou = P.ss "توهان ڪيئن آهيو" ;
+  GLookOut = P.ss "سنڀالي" ;
+  GNiceToMeetYou, GNiceToMeetYouPol = P.ss "توهان سان ملي ڪري سٺو لڳو" ;
+  GPleaseGive, GPleaseGivePol = P.ss "مهرباني ڪريو" ;
+  GSeeYouSoon = P.ss "موڪلاڻي ڪانهي" ;
+  GSorry, GSorryPol = P.ss "معاف ڪجو" ;
+  GThanks = P.ss "ٿورا" ;
+  GTheCheck = P.ss "بل" ;
+  GCongratulations = P.ss "مبارڪ هجي";
+  GHappyBirthday = P.ss "جنم ڏينهن مبارڪ" ;
+  GGoodLuck = P.ss "قسمت ڀلي هجي" ; 
+}

testsuite/lpgf/phrasebook/GreetingsSpa.gf

@@ -0,0 +1,31 @@
+concrete GreetingsSpa of Greetings = SentencesSpa [Greeting,mkGreeting] ** open Prelude in {
+
+flags coding = utf8 ;
+
+lin
+  GBye = mkGreeting "adiós" ;
+  GCheers = mkGreeting "salud" ;
+  GDamn = mkGreeting "joder" ;
+  GExcuse = mkGreeting "perdón" ;
+  GExcusePol = mkGreeting "perdone" ;
+  GCongratulations = mkGreeting "felicitaciones" ;
+  GGoodLuck = mkGreeting "buena suerte" ;
+  GHappyBirthday = mkGreeting "feliz cumpleaños" ;
+  GGoodMorning, GGoodDay = mkGreeting "buenos días" ;
+  GGoodEvening = mkGreeting "buenas tardes" ;
+  GGoodNight = mkGreeting "buenas noches" ;
+  GGoodbye = mkGreeting "hasta luego" ;
+  GHello = mkGreeting "hola" ;
+  GHelp = mkGreeting "socorro" ;
+  GHowAreYou = mkGreeting "cómo está" ; -- the polite singular "you"
+  GLookOut = mkGreeting "atención" ;
+  GNiceToMeetYou = mkGreeting "encantado de conocerle" ; -- the polite singular "you"
+  GPleaseGive, GPleaseGivePol = mkGreeting "por favor" ;
+  GSeeYouSoon = mkGreeting "nos vemos pronto" ;
+  GSorry = mkGreeting "disculpa" ;
+  GSorryPol = mkGreeting "disculpe" ;
+  GThanks = mkGreeting "gracias" ;
+  GTheCheck = mkGreeting "la cuenta" ;
+  GWhatTime = mkGreeting "qué hora es" ;
+
+}

testsuite/lpgf/phrasebook/GreetingsSwe.gf

@@ -0,0 +1,29 @@
+--# -coding=latin1
+concrete GreetingsSwe of Greetings = SentencesSwe [Greeting,mkGreeting] ** open Prelude in {
+
+lin 
+  GBye = mkGreeting "hej då" ;
+  GCheers = mkGreeting "skål" ;
+  GDamn = mkGreeting "fan" ;
+  GExcuse, GExcusePol = mkGreeting "ursäkta" ;
+  GGoodDay = mkGreeting "god dag" ;
+  GGoodEvening = mkGreeting "god afton" ;
+  GGoodMorning = mkGreeting "god morgon" ;
+  GGoodNight = mkGreeting "god natt" ;
+  GGoodbye = mkGreeting "hej då" ;
+  GHello = mkGreeting "hej" ;
+  GHelp = mkGreeting "hjälp" ;
+  GHowAreYou = mkGreeting "hur står det till" ;
+  GLookOut = mkGreeting "se upp" ;
+  GNiceToMeetYou, GNiceToMeetYouPol = mkGreeting "trevligt att träffas" ;
+  GPleaseGive, GPleaseGivePol = mkGreeting "var så god" ;
+  GSeeYouSoon = mkGreeting "vi ses snart" ;
+  GSorry, GSorryPol = mkGreeting "förlåt" ;
+  GThanks = mkGreeting "tack" ;
+  GTheCheck = mkGreeting "notan" ;
+  GCongratulations = mkGreeting "grattis";
+  GHappyBirthday = mkGreeting "grattis på födelsedagen" ;
+  GGoodLuck = mkGreeting "lycka till" ; 
+  GWhatTime = mkGreeting "vad är klockan" | mkGreeting "hur mycket är klockan" ;
+
+}

testsuite/lpgf/phrasebook/GreetingsTha.gf

@@ -0,0 +1,35 @@
+concrete GreetingsTha of Greetings = 
+  SentencesTha [Greeting,mkGreeting] ** 
+  open ResTha, Prelude in {
+
+-- สุขสันต์วันเกิด
+
+flags coding = utf8 ;
+
+lin 
+  GBye = mkGreeting (thword "ลา" "ก่อน") ;
+  GCheers = mkGreeting (thword "ไช" "โย") ;
+  GDamn = mkGreeting (thword "ชิบ" "หาย") ;
+  GExcuse, GExcusePol = mkGreeting (thword "ขอ" "โทษ") ;
+  GGoodDay = mkGreeting (thword "สวัส" "ดี") ;
+  GGoodEvening = mkGreeting (thword "สวัส" "ดี") ;
+  GGoodMorning = mkGreeting (thword "สวัส" "ดี") ;
+  GGoodNight = mkGreeting (thword "รา" "ตรี" "สวัส" "ดิ์") ;
+  GGoodbye = mkGreeting (thword "ลา" "ก่อน") ;
+  GHello = mkGreeting (thword "สวัส" "ดี") ;
+  GHelp = mkGreeting (thword "ช่วย" "ด้วย") ;
+  GHowAreYou = mkGreeting (thword "สบาย" "ดี" "ไหม") ;
+  GLookOut = mkGreeting (thword "ระ" "วัง") ; ---- google
+  GNiceToMeetYou, GNiceToMeetYouPol = 
+    mkGreeting (thword "ยิน" "ดี" "ที่" "ได้" "รู้" "จัก") ;
+  GPleaseGive, GPleaseGivePol = mkGreeting "นะ" ;
+  GSeeYouSoon = mkGreeting (thword "เจอ" "กัน" "นะ") ;
+  GSorry, GSorryPol = mkGreeting (thword "ขอ" "โทษ") ;
+  GThanks = mkGreeting (thword "ขอบ" "คุณ") ;
+  GTheCheck = mkGreeting (thword "เช็ค" "บิล") ;
+  GCongratulations = mkGreeting (thword "ยิน" "ดี" "ด้วย") ;
+  GHappyBirthday = mkGreeting (thword "สุข" "สันต์" "วัน" "เกิด") ;
+  GGoodLuck = mkGreeting (thword "โชค" "ดี" "นะ") ; 
+}
+
+

testsuite/lpgf/phrasebook/GreetingsUrd.gf

@@ -0,0 +1,29 @@
+concrete GreetingsUrd of Greetings = SentencesUrd [mkGreeting,Greeting] ** open (P=Prelude) in {
+
+-- lincat 
+--  Greeting = {s : Str; lock_Text : {}} ;
+flags coding = utf8 ;
+lin 
+  GBye = P.ss "خدا حافظ" ;
+  GCheers = P.ss "چیرز" ;
+  GDamn = P.ss "اف" ;
+  GExcuse, GExcusePol = P.ss "معاف كیجیے گا" ;
+  GGoodDay = P.ss "دن بخیر" ; ----
+  GGoodEvening = P.ss "شام بخیر" ;
+  GGoodMorning = P.ss "صبح بخیر" ;
+  GGoodNight = P.ss "رات بخیر" ;
+  GGoodbye = P.ss "خدا حافظ" ;
+  GHello = P.ss "اسلام علیكم" ;
+  GHelp = P.ss "مدد" ;
+  GHowAreYou = P.ss "آپ كیسی ہو" ;
+  GLookOut = P.ss "دیكھ كر" ;
+  GNiceToMeetYou, GNiceToMeetYouPol = P.ss "آپ سے مل كر اچھا لگا" ;
+  GPleaseGive, GPleaseGivePol = P.ss "مہربانی كر كے" ;
+  GSeeYouSoon = P.ss "ملتے ہیں" ;
+  GSorry, GSorryPol = P.ss "معاف كیجیے گا" ;
+  GThanks = P.ss "شكریہ" ;
+  GTheCheck = P.ss "بل" ;
+  GCongratulations = P.ss "مبارك ہو";
+  GHappyBirthday = P.ss "سالگرہ مبارك" ;
+  GGoodLuck = P.ss "گڈ لك" ; 
+}

testsuite/lpgf/phrasebook/Phrasebook-100.trees

@@ -0,0 +1,100 @@
+PSentence (SHaveNoMass (Children (Children WeFemale)) Chicken)
+PImperativeFamPos VSwim
+PGreetingFemale GHowAreYou
+PImperativeFamNeg VWrite
+PImperativeFamNeg VStop
+PImperativePlurNeg (V2Eat (OneObj (ObjMass Salt)))
+PQuestion (QProp (Is (ThisMass Chicken) (Too Fresh)))
+PImperativePolNeg (V2Eat (OneObj (ObjIndef Apple)))
+PImperativePlurNeg VWait
+PImperativeFamNeg VEat
+PSentence (SPropNot (PropOpen (APlace AmusementPark)))
+PImperativePolPos (V2Eat (OneObj (ObjMass Meat)))
+PImperativePolPos VWait
+PImperativeFamNeg VRun
+PImperativePolPos VStop
+PImperativePlurNeg VSleep
+PSentence (SHaveNo (Son (Daughter YouPlurPolMale)) (SuchKind (Very Fresh) Pizza))
+PImperativePolNeg VSwim
+PImperativePolNeg VWait
+PGreetingMale GGoodMorning
+PGreetingFemale GSorryPol
+PGreetingFemale GExcuse
+PImperativePlurPos VWalk
+PImperativePlurNeg VWalk
+PSentence (SHaveNo YouFamMale Pizza)
+PQuestion (HowFarFromBy (SuperlPlace TheMostExpensive Pharmacy) (SuperlPlace TheMostPopular Zoo) ByFoot)
+PImperativePolPos VWait
+PGreetingMale PNo
+PImperativePolNeg (V2Eat (OneObj (ObjIndef Pizza)))
+PImperativePlurPos (V2Eat (OneObj (ObjIndef Pizza)))
+PImperativeFamPos VDrink
+PGreetingMale GSeeYouSoon
+PImperativePolPos (V2Eat (OneObj (ObjPlural Apple)))
+PGreetingFemale PNo
+PImperativeFamNeg VRead
+PImperativeFamPos (V2Eat (OneObj (ObjPlural Pizza)))
+PImperativeFamPos VEat
+PImperativePlurPos VRead
+PSentence (SPropNot (PropClosedDay (SuperlPlace TheBest Station) Wednesday))
+PImperativePolPos (V2Eat (OneObj (ObjMass Meat)))
+PImperativeFamPos VPlay
+PGreetingMale GHappyBirthday
+PGreetingMale GPleaseGive
+PImperativeFamPos VStop
+PImperativeFamPos VRead
+PSentence (SPropNot (PropClosedDay (ThePlace Hotel) Thursday))
+PGreetingFemale PYes
+PImperativeFamNeg VWalk
+PGreetingMale GHello
+PImperativeFamNeg VSit
+PImperativeFamNeg VWrite
+PSentence (SHaveNoMass (Daughter YouPlurPolFemale) (SuchMassKind (PropQuality Boring) Salt))
+PImperativePlurNeg (V2Eat (OneObj (ObjMass Chicken)))
+PGreetingFemale GThanks
+PGreetingMale (PSeeYouPlaceDate (APlace Bank) Today)
+PImperativePlurPos VWalk
+PImperativeFamPos VWrite
+PImperativePolNeg VWait
+PQuestion (QWhereDoVerbPhrase (Husband YouPolMale) VEat)
+PImperativePlurNeg VStop
+PImperativeFamNeg VRun
+PImperativePolNeg VWrite
+PGreetingFemale PYesToNo
+PQuestion (HowFarBy (SuperlPlace TheWorst Church) ByFoot)
+PImperativeFamNeg VWalk
+PGreetingFemale GSorryPol
+PImperativePlurNeg VSit
+PImperativeFamNeg VWait
+PQuestion (HowFarBy (APlace Center) ByFoot)
+PImperativeFamPos VEat
+PImperativePlurPos VEat
+PGreetingMale GPleaseGive
+PImperativePlurPos VWrite
+PImperativeFamNeg VWait
+PImperativeFamPos VRun
+PQuestion (HowFar (APlace Zoo))
+PImperativeFamNeg (V2Wait (PersonName NameNN))
+PGreetingFemale GExcuse
+PImperativePlurNeg VSit
+PSentence (SHaveNo YouPolFemale (SuchKind (Too Cold) Apple))
+PGreetingFemale GGoodbye
+PImperativeFamPos VWait
+PImperativePolNeg VSit
+PGreetingMale GExcusePol
+PQuestion (WherePerson (Wife TheyMale))
+PImperativeFamPos VEat
+PImperativePlurNeg (V2Drink (OneObj (ObjPlural Apple)))
+PImperativeFamNeg (V2Eat (OneObj (ObjIndef Apple)))
+PImperativeFamPos VStop
+PImperativePlurNeg VStop
+PGreetingMale GGoodNight
+PGreetingFemale GWhatTime
+PQuestion (QWhereDoVerbPhrase YouPlurFamMale (V2Wait (Wife YouPlurPolMale)))
+PGreetingMale GNiceToMeetYou
+PGreetingFemale PYesToNo
+PImperativePlurPos VDrink
+PImperativeFamNeg VEat
+PImperativeFamPos VRead
+PSentence (SHave YouPlurPolFemale (OneObj (ObjIndef Pizza)))
+PSentence (SPropNot (PropOpenDay (SuperlPlace TheCheapest Supermarket) Thursday))

testsuite/lpgf/phrasebook/Phrasebook.gf

@@ -0,0 +1,8 @@
+abstract Phrasebook = 
+  Greetings,
+  Words
+  ** {
+
+flags startcat = Phrase ;
+
+}

testsuite/lpgf/phrasebook/PhrasebookBul.gf

@@ -0,0 +1,9 @@
+--# -path=.:present
+
+concrete PhrasebookBul of Phrasebook = 
+  GreetingsBul,
+  WordsBul ** open 
+    SyntaxBul,
+    Prelude in {
+
+}

testsuite/lpgf/phrasebook/PhrasebookCat.gf

@@ -0,0 +1,11 @@
+--# -path=.:present
+
+concrete PhrasebookCat of Phrasebook = 
+  GreetingsCat,
+  WordsCat
+  ** open 
+    SyntaxCat,
+    Prelude in {
+
+}
+

testsuite/lpgf/phrasebook/PhrasebookChi.gf

@@ -0,0 +1,11 @@
+--# -path=.:alltenses
+
+concrete PhrasebookChi of Phrasebook = 
+  GreetingsChi,
+  WordsChi
+ ** open 
+    SyntaxChi,
+    Prelude in {
+
+
+}

testsuite/lpgf/phrasebook/PhrasebookDan.gf

@@ -0,0 +1,9 @@
+--# -path=.:present:alltenses
+
+concrete PhrasebookDan of Phrasebook = 
+  GreetingsDan,
+  WordsDan ** open 
+    SyntaxDan,
+    Prelude in {
+
+}