Compare commits

..

7 Commits

Author SHA1 Message Date
John J. Camilleri
84fd431afd Manage to get completion working in PGF2 2021-05-03 22:28:48 +02:00
John J. Camilleri
588cd6ddb1 Improvement to test script, distinguishes when input ends with whitespace 2021-05-03 20:51:24 +02:00
John J. Camilleri
437bd8e7f9 Add proper error handling in complete 2021-05-03 20:36:31 +02:00
John J. Camilleri
e56d1b2959 Second attempt. Reading enum is closer to working but all strings are empty. 2021-05-03 14:25:35 +02:00
John J. Camilleri
450368f9bb First attempt at adding support for complete in PGF2 (gives segmentation faults) 2021-05-03 13:19:08 +02:00
John J. Camilleri
60bc752a6f Add note about type-checking dynamic expressions in PGF2 Haddock
Closes #72
2021-04-30 14:59:20 +02:00
John J. Camilleri
91278e2b4b Remove notice about example grammars not being included anymore from build scripts 2021-04-30 13:39:15 +02:00
217 changed files with 195 additions and 311219 deletions

1
.gitignore vendored
View File

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

View File

@@ -26,6 +26,14 @@ import Distribution.PackageDescription(PackageDescription(..))
so users won't see this message unless they check the log.)
-}
-- | Notice about contrib grammars
noContribMsg :: IO ()
noContribMsg = putStr $ unlines
[ "Example grammars are no longer included in the main GF repository, but have moved to gf-contrib."
, "If you want them to be built, clone the following repository in the same directory as gf-core:"
, "https://github.com/GrammaticalFramework/gf-contrib.git"
]
example_grammars :: [(String, String, [String])] -- [(pgf, subdir, source modules)]
example_grammars =
[("Letter.pgf","letter",letterSrc)
@@ -50,11 +58,8 @@ buildWeb gf flags (pkg,lbi) = do
contrib_exists <- doesDirectoryExist contrib_dir
if contrib_exists
then mapM_ build_pgf example_grammars
else putStr $ unlines
[ "Example grammars are no longer included in the main GF repository, but have moved to gf-contrib."
, "If you want these example grammars to be built, clone this repository in the same top-level directory as GF:"
, "https://github.com/GrammaticalFramework/gf-contrib.git"
]
-- else noContribMsg
else return ()
where
gfo_dir = buildDir lbi </> "examples"

407
gf.cabal
View File

@@ -86,10 +86,7 @@ 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,
text,
hashable,
unordered-containers
ghc-prim
hs-source-dirs: src/runtime/haskell
other-modules:
@@ -110,7 +107,6 @@ Library
PGF
PGF.Internal
PGF.Haskell
LPGF
other-modules:
PGF.Data
@@ -188,7 +184,6 @@ Library
GF.Compile.Export
GF.Compile.GenerateBC
GF.Compile.GeneratePMCFG
GF.Compile.GrammarToLPGF
GF.Compile.GrammarToPGF
GF.Compile.Multi
GF.Compile.Optimize
@@ -218,7 +213,6 @@ Library
GF.Data.ErrM
GF.Data.Graph
GF.Data.Graphviz
GF.Data.IntMapBuilder
GF.Data.Relation
GF.Data.Str
GF.Data.Utilities
@@ -359,402 +353,3 @@ 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

View File

@@ -1,7 +1,6 @@
module GF.Compile (compileToPGF, compileToLPGF, link, linkl, batchCompile, srcAbsName) where
module GF.Compile (compileToPGF, link, 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)
@@ -15,7 +14,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)
import Control.Monad(foldM,when,(<=<),filterM,liftM)
import GF.System.Directory(doesFileExist,getModificationTime)
import System.FilePath((</>),isRelative,dropFileName)
import qualified Data.Map as Map(empty,insert,elems) --lookup
@@ -25,16 +24,12 @@ 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
@@ -44,17 +39,9 @@ link opts (cnc,gr) =
pgf <- mkCanon2pgf opts gr abs
probs <- liftIO (maybe (return . defaultProbabilities) readProbabilitiesFromFile (flag optProbsFile opts) pgf)
when (verbAtLeast opts Normal) $ putStrE "OK"
return $ setProbabilities probs
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

View File

@@ -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(Options, optionsPGF)
import GF.Infra.Option(optionsPGF)
import PGF.Internal(Literal(..))
import GF.Compile.Compute.ConcreteNew(normalForm,resourceValues)
import GF.Grammar.Canonical as C
@@ -25,7 +25,6 @@ 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))
@@ -73,7 +72,7 @@ concrete2canonical gr cenv absname cnc modinfo =
[lincat|(_,Left lincat)<-defs]
[lin|(_,Right lin)<-defs]
where
defs = concatMap (toCanonical gr absname cenv) .
defs = concatMap (toCanonical gr absname cenv) .
M.toList $
jments modinfo
@@ -190,7 +189,7 @@ convert' gr vs = ppT
_ -> VarValue (gQId cPredef n) -- hmm
where
p = PredefValue . PredefId
ppP p =
case p of
PC c ps -> ParamPattern (Param (gId c) (map ppP ps))

View File

@@ -1,468 +0,0 @@
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, forM, forM_)
import qualified Control.Monad.State.Strict as CMS
import Data.List (elemIndex)
import qualified Data.List as L
import qualified Data.Map.Strict as Map
import Data.Maybe (fromJust, isJust)
import Data.Text (Text)
import qualified Data.Text as T
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 ab) 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.Abstract -> C.Concrete -> err (CId, L.Concrete)
mkConcrete debug (C.Abstract _ _ _ funs) (C.Concrete modId absModId flags params0 lincats lindefs0) = do
let
-- Some transformations on canonical grammar
params :: [C.ParamDef]
params = inlineParamAliases params0
lindefs :: [C.LinDef]
lindefs =
[ C.LinDef funId varIds linValue'
| (C.LinDef funId varIds linValue) <- lindefs0
, let Right linType = lookupLinType funId
, let linValue' = cleanupRecordFields linValue linType
]
-- 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
-- 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
-- Code generation
-- | Main code generation function
mkLin :: C.LinDef -> CodeGen (CId, L.LinFun)
mkLin (C.LinDef funId varIds linValue) = do
-- when debug $ trace funId
(lf, _) <- val2lin' linValue --skip memoisation at top level
return (fi2i funId, lf)
where
val2lin :: C.LinValue -> CodeGen (L.LinFun, Maybe C.LinType)
val2lin lv@(C.TableValue _ _) = do
-- val2lin lv@(C.ParamConstant _) = do
m <- CMS.get
case Map.lookup lv m of
Just r -> return r
Nothing -> do
r <- val2lin' lv
CMS.modify (Map.insert lv r)
return r
val2lin lv = val2lin' lv
val2lin' :: C.LinValue -> CodeGen (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 $ T.pack $ show f, Just C.FloatType)
C.IntConstant i -> return (L.Token $ T.pack $ show i, Just C.IntType)
C.StrConstant s -> return (L.Token $ T.pack s, Just C.StrType)
C.ErrorValue err -> return (L.Error err, Nothing)
C.ParamConstant (C.Param pid lvs) -> do
let
collectProjections :: C.LinValue -> CodeGen [L.LinFun]
collectProjections (C.ParamConstant (C.Param pid lvs)) = do
def <- CMS.lift $ lookupParamDef pid
let (C.ParamDef tpid defpids) = def
pidIx <- CMS.lift $ 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 <- CMS.lift $ 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)
_ -> CMS.lift $ 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] -> CodeGen (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 <- CMS.lift $ eitherElemIndex (C.VarId v) varIds
lt <- CMS.lift $ 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 (map T.pack 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 -> CMS.lift $ Left $ printf "val2lin not implemented for: %s" (show v)
-- Invoke code generation
let e = flip CMS.evalStateT Map.empty $ mapM mkLin lindefs
case e of
Left err -> raise err
Right lins -> do
let maybeOptimise = if debug then id else extractStrings
let concr = maybeOptimise $ L.Concrete {
L.toks = IntMapBuilder.emptyIntMap,
L.lins = Map.fromList lins
}
return (mdi2i modId, concr)
type CodeGen a = CMS.StateT (Map.Map C.LinValue (L.LinFun, Maybe C.LinType)) (Either String) a
-- | 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 Text) (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 Text) 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 = T.pack $ 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

View File

@@ -1,11 +1,9 @@
module GF.Compiler (mainGFC, linkGrammars, writePGF, writeLPGF, writeOutputs) where
module GF.Compiler (mainGFC, linkGrammars, writePGF, writeOutputs) where
import PGF
import PGF.Internal(concretes,optimizePGF,unionPGF)
import PGF.Internal(putSplitAbs,encodeFile,runPut)
import LPGF(LPGF)
import qualified LPGF
import GF.Compile as S(batchCompile,link,linkl,srcAbsName)
import GF.Compile as S(batchCompile,link,srcAbsName)
import GF.CompileInParallel as P(parallelBatchCompile)
import GF.Compile.Export
import GF.Compile.ConcreteToHaskell(concretes2haskell)
@@ -13,8 +11,7 @@ import GF.Compile.GrammarToCanonical--(concretes2canonical)
import GF.Compile.CFGtoPGF
import GF.Compile.GetGrammar
import GF.Grammar.BNFC
import GF.Grammar.CFG hiding (Grammar)
import GF.Grammar.Grammar (Grammar, ModuleName)
import GF.Grammar.CFG
--import GF.Infra.Ident(showIdent)
import GF.Infra.UseIO
@@ -26,11 +23,10 @@ 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,void)
import Control.Monad(when,unless,forM_)
-- | 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@)
@@ -51,7 +47,7 @@ mainGFC opts fs = do
extensionIs ext = (== ext) . takeExtension
compileSourceFiles :: Options -> [FilePath] -> IOE ()
compileSourceFiles opts fs =
compileSourceFiles opts fs =
do output <- batchCompile opts fs
exportCanonical output
unless (flag optStopAfterPhase opts == Compile) $
@@ -97,10 +93,6 @@ 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")
@@ -153,7 +145,7 @@ unionPGFFiles opts fs =
pgfFile = outputPath opts (grammarName opts pgf <.> "pgf")
if pgfFile `elem` fs
then putStrLnE $ "Refusing to overwrite " ++ pgfFile
else void $ writePGF opts pgf
else writePGF opts pgf
writeOutputs opts pgf
readPGFVerbose f =
@@ -163,46 +155,33 @@ unionPGFFiles opts fs =
-- Calls 'exportPGF'.
writeOutputs :: Options -> PGF -> IOE ()
writeOutputs opts pgf = do
sequence_ [writeOutput opts name str
sequence_ [writeOutput opts name str
| fmt <- flag optOutputFormats opts,
(name,str) <- exportPGF opts fmt pgf]
-- | 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 [FilePath]
writePGF :: Options -> PGF -> IOE ()
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)
outfiles <- forM (Map.toList (concretes pgf)) $ \cnc -> do
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)
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
writeOutput :: Options -> FilePath-> String -> IOE ()
writeOutput opts file str = writing opts path $ writeUTF8File path str
where path = outputPath opts file
-- * Useful helper functions

View File

@@ -1,61 +0,0 @@
-- | 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
}
-- | An empty IntMap
emptyIntMap :: IntMap a
emptyIntMap = IntMap.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

View File

@@ -30,7 +30,7 @@ data TypeApp = TypeApp CatId [Type] deriving Show
data TypeBinding = TypeBinding VarId Type deriving Show
--------------------------------------------------------------------------------
-- ** Concrete syntax
-- ** Concreate syntax
-- | Concrete Syntax
data Concrete = Concrete ModId ModId Flags [ParamDef] [LincatDef] [LinDef]
@@ -44,12 +44,12 @@ data LincatDef = LincatDef CatId LinType deriving Show
data LinDef = LinDef FunId [VarId] LinValue deriving Show
-- | Linearization type, RHS of @lincat@
data LinType = FloatType
| IntType
data LinType = FloatType
| IntType
| ParamType ParamType
| RecordType [RecordRowType]
| StrType
| TableType LinType LinType
| StrType
| TableType LinType LinType
| TupleType [LinType]
deriving (Eq,Ord,Show)
@@ -59,7 +59,7 @@ newtype ParamType = ParamTypeId ParamId deriving (Eq,Ord,Show)
data LinValue = ConcatValue LinValue LinValue
| LiteralValue LinLiteral
| ErrorValue String
| ParamConstant ParamValue
| ParamConstant ParamValue
| PredefValue PredefId
| RecordValue [RecordRowValue]
| TableValue LinType [TableRowValue]
@@ -73,9 +73,9 @@ data LinValue = ConcatValue LinValue LinValue
| CommentedValue String LinValue
deriving (Eq,Ord,Show)
data LinLiteral = FloatConstant Float
| IntConstant Int
| StrConstant String
data LinLiteral = FloatConstant Float
| IntConstant Int
| StrConstant String
deriving (Eq,Ord,Show)
data LinPattern = ParamPattern ParamPattern
@@ -102,11 +102,11 @@ data TableRow rhs = TableRow LinPattern rhs
-- *** Identifiers in Concrete Syntax
newtype PredefId = PredefId Id deriving (Eq,Ord,Show)
newtype LabelId = LabelId Id deriving (Eq,Ord,Show)
newtype VarValueId = VarValueId QualId deriving (Eq,Ord,Show)
newtype PredefId = PredefId Id deriving (Eq,Ord,Show)
newtype LabelId = LabelId Id deriving (Eq,Ord,Show)
data VarValueId = VarValueId QualId deriving (Eq,Ord,Show)
-- | Name of param type or param value
-- | 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,Ord,Show)
newtype FunId = FunId Id deriving (Eq,Show)
data VarId = Anonymous | VarId Id deriving (Eq,Show)
data VarId = Anonymous | VarId Id deriving Show
newtype Flags = Flags [(FlagName,FlagValue)] deriving Show
type FlagName = Id
@@ -249,7 +249,7 @@ instance PPA LinLiteral where
FloatConstant f -> pp f
IntConstant n -> pp n
StrConstant s -> doubleQuotes s -- hmm
instance RhsSeparator LinValue where rhsSep _ = pp "="
instance Pretty LinPattern where
@@ -264,7 +264,7 @@ instance PPA LinPattern where
ParamPattern pv -> ppA pv
RecordPattern r -> block r
TuplePattern ps -> "<"<>punctuate "," ps<>">"
WildPattern -> pp "_"
WildPattern -> pp "_"
_ -> parens p
instance RhsSeparator LinPattern where rhsSep _ = pp "="

View File

@@ -2,13 +2,13 @@ module GF.Infra.Option
(
-- ** Command line options
-- *** Option types
Options,
Flags(..),
Mode(..), Phase(..), Verbosity(..),
OutputFormat(..),
Options,
Flags(..),
Mode(..), Phase(..), Verbosity(..),
OutputFormat(..),
SISRFormat(..), Optimization(..), CFGTransform(..), HaskellOption(..),
Dump(..), Pass(..), Recomp(..),
outputFormatsExpl,
outputFormatsExpl,
-- *** Option parsing
parseOptions, parseModuleOptions, fixRelativeLibPaths,
-- *** Option pretty-printing
@@ -47,7 +47,7 @@ import PGF.Internal(Literal(..))
import qualified Control.Monad.Fail as Fail
usageHeader :: String
usageHeader = unlines
usageHeader = unlines
["Usage: gf [OPTIONS] [FILE [...]]",
"",
"How each FILE is handled depends on the file name suffix:",
@@ -87,14 +87,13 @@ data Verbosity = Quiet | Normal | Verbose | Debug
data Phase = Preproc | Convert | Compile | Link
deriving (Show,Eq,Ord)
data OutputFormat = FmtLPGF
| FmtPGFPretty
data OutputFormat = FmtPGFPretty
| FmtCanonicalGF
| FmtCanonicalJson
| FmtJavaScript
| FmtJavaScript
| FmtJSON
| FmtPython
| FmtHaskell
| FmtPython
| FmtHaskell
| FmtJava
| FmtProlog
| FmtBNF
@@ -103,30 +102,30 @@ data OutputFormat = FmtLPGF
| FmtNoLR
| FmtSRGS_XML
| FmtSRGS_XML_NonRec
| FmtSRGS_ABNF
| FmtSRGS_ABNF
| FmtSRGS_ABNF_NonRec
| FmtJSGF
| FmtGSL
| FmtJSGF
| FmtGSL
| FmtVoiceXML
| FmtSLF
| FmtRegExp
| FmtFA
deriving (Eq,Ord)
data SISRFormat =
data SISRFormat =
-- | SISR Working draft 1 April 2003
-- <http://www.w3.org/TR/2003/WD-semantic-interpretation-20030401/>
SISR_WD20030401
SISR_WD20030401
| SISR_1_0
deriving (Show,Eq,Ord)
data Optimization = OptStem | OptCSE | OptExpand | OptParametrize
deriving (Show,Eq,Ord)
data CFGTransform = CFGNoLR
data CFGTransform = CFGNoLR
| CFGRegular
| CFGTopDownFilter
| CFGBottomUpFilter
| CFGTopDownFilter
| CFGBottomUpFilter
| CFGStartCatOnly
| CFGMergeIdentical
| CFGRemoveCycles
@@ -197,7 +196,7 @@ instance Show Options where
parseOptions :: ErrorMonad err =>
[String] -- ^ list of string arguments
-> err (Options, [FilePath])
parseOptions args
parseOptions args
| not (null errs) = errors errs
| otherwise = do opts <- concatOptions `fmap` liftErr (sequence optss)
return (opts, files)
@@ -209,7 +208,7 @@ parseModuleOptions :: ErrorMonad err =>
-> err Options
parseModuleOptions args = do
(opts,nonopts) <- parseOptions args
if null nonopts
if null nonopts
then return opts
else errors $ map ("Non-option among module options: " ++) nonopts
@@ -282,7 +281,7 @@ defaultFlags = Flags {
optOptimizations = Set.fromList [OptStem,OptCSE,OptExpand,OptParametrize],
optOptimizePGF = False,
optSplitPGF = False,
optCFGTransforms = Set.fromList [CFGRemoveCycles, CFGBottomUpFilter,
optCFGTransforms = Set.fromList [CFGRemoveCycles, CFGBottomUpFilter,
CFGTopDownFilter, CFGMergeIdentical],
optLibraryPath = [],
optStartCat = Nothing,
@@ -302,7 +301,7 @@ defaultFlags = Flags {
-- | Option descriptions
{-# NOINLINE optDescr #-}
optDescr :: [OptDescr (Err Options)]
optDescr =
optDescr =
[
Option ['?','h'] ["help"] (NoArg (mode ModeHelp)) "Show help message.",
Option ['V'] ["version"] (NoArg (mode ModeVersion)) "Display GF version number.",
@@ -328,44 +327,44 @@ optDescr =
-- Option ['t'] ["trace"] (NoArg (trace True)) "Trace computations",
-- Option [] ["no-trace"] (NoArg (trace False)) "Don't trace computations",
Option [] ["gfo-dir"] (ReqArg gfoDir "DIR") "Directory to put .gfo files in (default = '.').",
Option ['f'] ["output-format"] (ReqArg outFmt "FMT")
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), lpgf, json, js, pgf_pretty, prolog, python, ...", -- gar,
"Multiple concrete: pgf (default), 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")
Option [] ["sisr"] (ReqArg sisrFmt "FMT")
(unlines ["Include SISR tags in generated speech recognition grammars.",
"FMT can be one of: old, 1.0"]),
Option [] ["haskell"] (ReqArg hsOption "OPTION")
("Turn on an optional feature when generating Haskell data types. OPTION = "
Option [] ["haskell"] (ReqArg hsOption "OPTION")
("Turn on an optional feature when generating Haskell data types. OPTION = "
++ concat (intersperse " | " (map fst haskellOptionNames))),
Option [] ["lexical"] (ReqArg lexicalCat "CAT[,CAT[...]]")
Option [] ["lexical"] (ReqArg lexicalCat "CAT[,CAT[...]]")
"Treat CAT as a lexical category.",
Option [] ["literal"] (ReqArg literalCat "CAT[,CAT[...]]")
Option [] ["literal"] (ReqArg literalCat "CAT[,CAT[...]]")
"Treat CAT as a literal category.",
Option ['D'] ["output-dir"] (ReqArg outDir "DIR")
Option ['D'] ["output-dir"] (ReqArg outDir "DIR")
"Save output files (other than .gfo files) in DIR.",
Option [] ["gf-lib-path"] (ReqArg gfLibPath "DIR")
Option [] ["gf-lib-path"] (ReqArg gfLibPath "DIR")
"Overrides the value of GF_LIB_PATH.",
Option [] ["src","force-recomp"] (NoArg (recomp AlwaysRecomp))
Option [] ["src","force-recomp"] (NoArg (recomp AlwaysRecomp))
"Always recompile from source.",
Option [] ["recomp-if-newer"] (NoArg (recomp RecompIfNewer))
Option [] ["recomp-if-newer"] (NoArg (recomp RecompIfNewer))
"(default) Recompile from source if the source is newer than the .gfo file.",
Option [] ["gfo","no-recomp"] (NoArg (recomp NeverRecomp))
Option [] ["gfo","no-recomp"] (NoArg (recomp NeverRecomp))
"Never recompile from source, if there is already .gfo file.",
Option [] ["retain"] (NoArg (set $ \o -> o { optRetainResource = True })) "Retain opers.",
Option [] ["probs"] (ReqArg probsFile "file.probs") "Read probabilities from file.",
Option ['n'] ["name"] (ReqArg name "NAME")
Option ['n'] ["name"] (ReqArg name "NAME")
(unlines ["Use NAME as the name of the output. This is used in the output file names, ",
"with suffixes depending on the formats, and, when relevant, ",
"internally in the output."]),
Option ['i'] [] (ReqArg addLibDir "DIR") "Add DIR to the library search path.",
Option [] ["path"] (ReqArg setLibPath "DIR:DIR:...") "Set the library search path.",
Option [] ["preproc"] (ReqArg preproc "CMD")
Option [] ["preproc"] (ReqArg preproc "CMD")
(unlines ["Use CMD to preprocess input files.",
"Multiple preprocessors can be used by giving this option multiple times."]),
Option [] ["coding"] (ReqArg coding "ENCODING")
Option [] ["coding"] (ReqArg coding "ENCODING")
("Character encoding of the source grammar, ENCODING = utf8, latin1, cp1251, ..."),
Option [] ["startcat"] (ReqArg startcat "CAT") "Grammar start category.",
Option [] ["language"] (ReqArg language "LANG") "Set the speech language flag to LANG in the generated grammar.",
@@ -373,7 +372,7 @@ optDescr =
Option [] ["unlexer"] (ReqArg unlexer "UNLEXER") "Use unlexer UNLEXER.",
Option [] ["pmcfg"] (NoArg (pmcfg True)) "Generate PMCFG (default).",
Option [] ["no-pmcfg"] (NoArg (pmcfg False)) "Don't generate PMCFG (useful for libraries).",
Option [] ["optimize"] (ReqArg optimize "OPT")
Option [] ["optimize"] (ReqArg optimize "OPT")
"Select an optimization package. OPT = all | values | parametrize | none",
Option [] ["optimize-pgf"] (NoArg (optimize_pgf True))
"Enable or disable global grammar optimization. This could significantly reduce the size of the final PGF file",
@@ -448,7 +447,7 @@ optDescr =
optimize x = case lookup x optimizationPackages of
Just p -> set $ \o -> o { optOptimizations = p }
Nothing -> fail $ "Unknown optimization package: " ++ x
optimize_pgf x = set $ \o -> o { optOptimizePGF = x }
splitPGF x = set $ \o -> o { optSplitPGF = x }
@@ -472,9 +471,8 @@ outputFormats :: [(String,OutputFormat)]
outputFormats = map fst outputFormatsExpl
outputFormatsExpl :: [((String,OutputFormat),String)]
outputFormatsExpl =
[(("lpgf", FmtLPGF),"Linearisation-only PGF"),
(("pgf_pretty", FmtPGFPretty),"Human-readable PGF"),
outputFormatsExpl =
[(("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)"),
@@ -506,11 +504,11 @@ instance Read OutputFormat where
readsPrec = lookupReadsPrec outputFormats
optimizationPackages :: [(String, Set Optimization)]
optimizationPackages =
optimizationPackages =
[("all", Set.fromList [OptStem,OptCSE,OptExpand,OptParametrize]),
("values", Set.fromList [OptStem,OptCSE,OptExpand]),
("noexpand", Set.fromList [OptStem,OptCSE]),
-- deprecated
("all_subs", Set.fromList [OptStem,OptCSE,OptExpand,OptParametrize]),
("parametrize", Set.fromList [OptStem,OptCSE,OptExpand,OptParametrize]),
@@ -518,7 +516,7 @@ optimizationPackages =
]
cfgTransformNames :: [(String, CFGTransform)]
cfgTransformNames =
cfgTransformNames =
[("nolr", CFGNoLR),
("regular", CFGRegular),
("topdown", CFGTopDownFilter),
@@ -560,7 +558,7 @@ onOff f def = OptArg g "[on,off]"
_ -> fail $ "Expected [on,off], got: " ++ show x
readOutputFormat :: Fail.MonadFail m => String -> m OutputFormat
readOutputFormat s =
readOutputFormat s =
maybe (fail $ "Unknown output format: " ++ show s) return $ lookup s outputFormats
-- FIXME: this is a copy of the function in GF.Devel.UseIO.
@@ -572,7 +570,7 @@ splitInModuleSearchPath s = case break isPathSep s of
isPathSep :: Char -> Bool
isPathSep c = c == ':' || c == ';'
--
--
-- * Convenience functions for checking options
--
@@ -594,7 +592,7 @@ isLiteralCat opts c = Set.member c (flag optLiteralCats opts)
isLexicalCat :: Options -> String -> Bool
isLexicalCat opts c = Set.member c (flag optLexicalCats opts)
--
--
-- * Convenience functions for setting options
--
@@ -625,8 +623,8 @@ readMaybe s = case reads s of
toEnumBounded :: (Bounded a, Enum a, Ord a) => Int -> Maybe a
toEnumBounded i = let mi = minBound
ma = maxBound `asTypeOf` mi
in if i >= fromEnum mi && i <= fromEnum ma
ma = maxBound `asTypeOf` mi
in if i >= fromEnum mi && i <= fromEnum ma
then Just (toEnum i `asTypeOf` mi)
else Nothing

View File

@@ -1,7 +1,11 @@
## 1.3.0
- Add completion support.
## 1.2.1
- Remove deprecated pgf_print_expr_tuple
- Added an API for cloning expressions/types/literals
- Remove deprecated `pgf_print_expr_tuple`.
- Added an API for cloning expressions/types/literals.
## 1.2.0

View File

@@ -43,30 +43,28 @@ module PGF2 (-- * PGF
mkCId,
exprHash, exprSize, exprFunctions, exprSubstitute,
treeProbability,
-- ** Types
Type, Hypo, BindType(..), startCat,
readType, showType, showContext,
mkType, unType,
-- ** Type checking
-- | Dynamically-built expressions should always be type-checked before using in other functions,
-- as the exceptions thrown by using invalid expressions may not catchable.
checkExpr, inferExpr, checkType,
-- ** Computing
compute,
-- * Concrete syntax
ConcName,Concr,languages,concreteName,languageCode,
-- ** Linearization
linearize,linearizeAll,tabularLinearize,tabularLinearizeAll,bracketedLinearize,bracketedLinearizeAll,
FId, BracketedString(..), showBracketedString, flattenBracketedString,
printName, categoryFields,
alignWords,
-- ** Parsing
ParseOutput(..), parse, parseWithHeuristics,
parseToChart, PArg(..),
complete,
-- ** Sentence Lookup
lookupSentence,
-- ** Generation
@@ -180,7 +178,7 @@ languageCode c = unsafePerformIO (peekUtf8CString =<< pgf_language_code (concr c
-- | Generates an exhaustive possibly infinite list of
-- all abstract syntax expressions of the given type.
-- all abstract syntax expressions of the given type.
-- The expressions are ordered by their probability.
generateAll :: PGF -> Type -> [(Expr,Float)]
generateAll p (Type ctype _) =
@@ -469,21 +467,21 @@ newGraphvizOptions pool opts = do
-- Functions using Concr
-- Morpho analyses, parsing & linearization
-- | This triple is returned by all functions that deal with
-- | This triple is returned by all functions that deal with
-- the grammar's lexicon. Its first element is the name of an abstract
-- lexical function which can produce a given word or
-- lexical function which can produce a given word or
-- a multiword expression (i.e. this is the lemma).
-- After that follows a string which describes
-- After that follows a string which describes
-- the particular inflection form.
--
-- The last element is a logarithm from the
-- the probability of the function. The probability is not
-- the probability of the function. The probability is not
-- conditionalized on the category of the function. This makes it
-- possible to compare the likelihood of two functions even if they
-- have different types.
-- have different types.
type MorphoAnalysis = (Fun,String,Float)
-- | 'lookupMorpho' takes a string which must be a single word or
-- | 'lookupMorpho' takes a string which must be a single word or
-- a multiword expression. It then computes the list of all possible
-- morphological analyses.
lookupMorpho :: Concr -> String -> [MorphoAnalysis]
@@ -541,12 +539,12 @@ lookupCohorts lang@(Concr concr master) sent =
return ((start,tok,ans,end):cohs)
filterBest :: [(Int,String,[MorphoAnalysis],Int)] -> [(Int,String,[MorphoAnalysis],Int)]
filterBest ans =
filterBest ans =
reverse (iterate (maxBound :: Int) [(0,0,[],ans)] [] [])
where
iterate v0 [] [] res = res
iterate v0 [] new res = iterate v0 new [] res
iterate v0 ((_,v,conf, []):old) new res =
iterate v0 ((_,v,conf, []):old) new res =
case compare v0 v of
LT -> res
EQ -> iterate v0 old new (merge conf res)
@@ -649,7 +647,7 @@ getAnalysis ref self c_lemma c_anal prob exn = do
data ParseOutput a
= ParseFailed Int String -- ^ The integer is the position in number of unicode characters where the parser failed.
-- The string is the token where the parser have failed.
| ParseOk a -- ^ If the parsing and the type checking are successful
| ParseOk a -- ^ If the parsing and the type checking are successful
-- we get the abstract syntax trees as either a list or a chart.
| ParseIncomplete -- ^ The sentence is not complete.
@@ -659,9 +657,9 @@ parse lang ty sent = parseWithHeuristics lang ty sent (-1.0) []
parseWithHeuristics :: Concr -- ^ the language with which we parse
-> Type -- ^ the start category
-> String -- ^ the input sentence
-> Double -- ^ the heuristic factor.
-- A negative value tells the parser
-- to lookup up the default from
-> Double -- ^ the heuristic factor.
-- A negative value tells the parser
-- to lookup up the default from
-- the grammar flags
-> [(Cat, String -> Int -> Maybe (Expr,Float,Int))]
-- ^ a list of callbacks for literal categories.
@@ -715,9 +713,9 @@ parseWithHeuristics lang (Type ctype touchType) sent heuristic callbacks =
parseToChart :: Concr -- ^ the language with which we parse
-> Type -- ^ the start category
-> String -- ^ the input sentence
-> Double -- ^ the heuristic factor.
-- A negative value tells the parser
-- to lookup up the default from
-> Double -- ^ the heuristic factor.
-- A negative value tells the parser
-- to lookup up the default from
-- the grammar flags
-> [(Cat, String -> Int -> Maybe (Expr,Float,Int))]
-- ^ a list of callbacks for literal categories.
@@ -886,7 +884,7 @@ lookupSentence lang (Type ctype _) sent =
-- | The oracle is a triple of functions.
-- The first two take a category name and a linearization field name
-- and they should return True/False when the corresponding
-- and they should return True/False when the corresponding
-- prediction or completion is appropriate. The third function
-- is the oracle for literals.
type Oracle = (Maybe (Cat -> String -> Int -> Bool)
@@ -974,6 +972,67 @@ parseWithOracle lang cat sent (predict,complete,literal) =
return ep
Nothing -> do return nullPtr
-- | Returns possible completions of the current partial input.
complete :: Concr -- ^ the language with which we parse
-> Type -- ^ the start category
-> String -- ^ the input sentence (excluding token being completed)
-> String -- ^ prefix (partial token being completed)
-> ParseOutput [(String, CId, CId, Float)] -- ^ (token, category, function, probability)
complete lang (Type ctype _) sent pfx =
unsafePerformIO $ do
parsePl <- gu_new_pool
exn <- gu_new_exn parsePl
sent <- newUtf8CString sent parsePl
pfx <- newUtf8CString pfx parsePl
enum <- pgf_complete (concr lang) ctype sent pfx exn parsePl
failed <- gu_exn_is_raised exn
if failed
then do
is_parse_error <- gu_exn_caught exn gu_exn_type_PgfParseError
if is_parse_error
then do
c_err <- (#peek GuExn, data.data) exn
c_offset <- (#peek PgfParseError, offset) c_err
token_ptr <- (#peek PgfParseError, token_ptr) c_err
token_len <- (#peek PgfParseError, token_len) c_err
tok <- peekUtf8CStringLen token_ptr token_len
gu_pool_free parsePl
return (ParseFailed (fromIntegral (c_offset :: CInt)) tok)
else do
is_exn <- gu_exn_caught exn gu_exn_type_PgfExn
if is_exn
then do
c_msg <- (#peek GuExn, data.data) exn
msg <- peekUtf8CString c_msg
gu_pool_free parsePl
throwIO (PGFError msg)
else do
gu_pool_free parsePl
throwIO (PGFError "Parsing failed")
else do
fpl <- newForeignPtr gu_pool_finalizer parsePl
ParseOk <$> fromCompletions enum fpl
where
fromCompletions :: Ptr GuEnum -> ForeignPtr GuPool -> IO [(String, CId, CId, Float)]
fromCompletions enum fpl =
withGuPool $ \tmpPl -> do
cmpEntry <- alloca $ \ptr ->
withForeignPtr fpl $ \pl ->
do gu_enum_next enum ptr pl
peek ptr
if cmpEntry == nullPtr
then do
finalizeForeignPtr fpl
touchConcr lang
return []
else do
tok <- peekUtf8CString =<< (#peek PgfTokenProb, tok) cmpEntry
cat <- peekUtf8CString =<< (#peek PgfTokenProb, cat) cmpEntry
fun <- peekUtf8CString =<< (#peek PgfTokenProb, fun) cmpEntry
prob <- (#peek PgfTokenProb, prob) cmpEntry
toks <- unsafeInterleaveIO (fromCompletions enum fpl)
return ((tok, cat, fun, prob) : toks)
-- | Returns True if there is a linearization defined for that function in that language
hasLinearization :: Concr -> Fun -> Bool
hasLinearization lang id = unsafePerformIO $
@@ -1047,7 +1106,7 @@ linearizeAll lang e = unsafePerformIO $
-- | Generates a table of linearizations for an expression
tabularLinearize :: Concr -> Expr -> [(String, String)]
tabularLinearize lang e =
tabularLinearize lang e =
case tabularLinearizeAll lang e of
(lins:_) -> lins
_ -> []
@@ -1138,7 +1197,7 @@ data BracketedString
-- the phrase. The 'FId' is an unique identifier for
-- every phrase in the sentence. For context-free grammars
-- i.e. without discontinuous constituents this identifier
-- is also unique for every bracket. When there are discontinuous
-- is also unique for every bracket. When there are discontinuous
-- phrases then the identifiers are unique for every phrase but
-- not for every bracket since the bracket represents a constituent.
-- The different constituents could still be distinguished by using
@@ -1148,7 +1207,7 @@ data BracketedString
-- The second 'CId' is the name of the abstract function that generated
-- this phrase.
-- | Renders the bracketed string as a string where
-- | Renders the bracketed string as a string where
-- the brackets are shown as @(S ...)@ where
-- @S@ is the category.
showBracketedString :: BracketedString -> String
@@ -1166,7 +1225,7 @@ flattenBracketedString (Bracket _ _ _ _ bss) = concatMap flattenBracketedString
bracketedLinearize :: Concr -> Expr -> [BracketedString]
bracketedLinearize lang e = unsafePerformIO $
withGuPool $ \pl ->
withGuPool $ \pl ->
do exn <- gu_new_exn pl
cts <- pgf_lzr_concretize (concr lang) (expr e) exn pl
failed <- gu_exn_is_raised exn
@@ -1192,7 +1251,7 @@ bracketedLinearize lang e = unsafePerformIO $
bracketedLinearizeAll :: Concr -> Expr -> [[BracketedString]]
bracketedLinearizeAll lang e = unsafePerformIO $
withGuPool $ \pl ->
withGuPool $ \pl ->
do exn <- gu_new_exn pl
cts <- pgf_lzr_concretize (concr lang) (expr e) exn pl
failed <- gu_exn_is_raised exn
@@ -1467,7 +1526,7 @@ type LiteralCallback =
literalCallbacks :: [(AbsName,[(Cat,LiteralCallback)])]
literalCallbacks = [("App",[("PN",nerc),("Symb",chunk)])]
-- | Named entity recognition for the App grammar
-- | Named entity recognition for the App grammar
-- (based on ../java/org/grammaticalframework/pgf/NercLiteralCallback.java)
nerc :: LiteralCallback
nerc pgf (lang,concr) sentence lin_idx offset =

View File

@@ -103,7 +103,7 @@ foreign import ccall unsafe "gu/file.h gu_file_in"
foreign import ccall safe "gu/enum.h gu_enum_next"
gu_enum_next :: Ptr a -> Ptr (Ptr b) -> Ptr GuPool -> IO ()
foreign import ccall unsafe "gu/string.h gu_string_buf_freeze"
gu_string_buf_freeze :: Ptr GuStringBuf -> Ptr GuPool -> IO CString
@@ -241,7 +241,7 @@ newSequence elem_size pokeElem values pool = do
type FId = Int
data PArg = PArg [FId] {-# UNPACK #-} !FId deriving (Eq,Ord,Show)
peekFId :: Ptr a -> IO FId
peekFId :: Ptr a -> IO FId
peekFId c_ccat = do
c_fid <- (#peek PgfCCat, fid) c_ccat
return (fromIntegral (c_fid :: CInt))
@@ -256,6 +256,7 @@ data PgfApplication
data PgfConcr
type PgfExpr = Ptr ()
data PgfExprProb
data PgfTokenProb
data PgfExprParser
data PgfFullFormEntry
data PgfMorphoCallback
@@ -422,6 +423,9 @@ foreign import ccall
foreign import ccall "pgf/pgf.h pgf_parse_with_oracle"
pgf_parse_with_oracle :: Ptr PgfConcr -> CString -> CString -> Ptr PgfOracleCallback -> Ptr GuExn -> Ptr GuPool -> Ptr GuPool -> IO (Ptr GuEnum)
foreign import ccall "pgf/pgf.h pgf_complete"
pgf_complete :: Ptr PgfConcr -> PgfType -> CString -> CString -> Ptr GuExn -> Ptr GuPool -> IO (Ptr GuEnum)
foreign import ccall "pgf/pgf.h pgf_lookup_morpho"
pgf_lookup_morpho :: Ptr PgfConcr -> CString -> Ptr PgfMorphoCallback -> Ptr GuExn -> IO ()

View File

@@ -1,5 +1,5 @@
name: pgf2
version: 1.2.1
version: 1.3.0
synopsis: Bindings to the C version of the PGF runtime
description:
GF, Grammatical Framework, is a programming language for multilingual grammar applications.

View File

@@ -1,381 +0,0 @@
{-# 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.Binary (Binary, put, get, putWord8, getWord8, encodeFile, decodeFile)
import Data.Either (isLeft)
import qualified Data.IntMap as IntMap
import qualified Data.Map.Strict as Map
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import 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 Text, -- ^ 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 [([Text], LinFun)] LinFun
| Missing CId -- ^ missing definition (inserted at runtime)
-- From original definition in paper
| Empty
| Token Text
| 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"
instance Binary Text where
put = put . TE.encodeUtf8
get = liftM TE.decodeUtf8 get
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 expr = T.unpack $ linearizeText lpgf lang expr
-- | Main linearize function, to 'Data.Text.Text'
linearizeText :: LPGF -> Language -> Expr -> Text
linearizeText lpgf lang =
case Map.lookup lang (concretes lpgf) of
Just concr -> linearizeConcreteText concr
Nothing -> error $ printf "Unknown language: %s" (showCId lang)
-- | Language-specific linearize function, to 'String'
linearizeConcrete :: Concrete -> Expr -> String
linearizeConcrete concr expr = T.unpack $ linearizeConcreteText concr expr
-- | Language-specific linearize function, to 'Data.Text.Text'
linearizeConcreteText :: Concrete -> Expr -> Text
linearizeConcreteText 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 Text -- ^ 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 . T.unpack) $ 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 -> Text
lin2string lf = T.unwords $ join $ flatten [lf]
where
-- Process bind et al into final token list
join :: [Either LinFun Text] -> [Text]
join elt = case elt of
Right tok:Left Bind:ls ->
case join ls of
next:ls' -> tok `T.append` next : ls'
_ -> []
Right tok:ls -> tok : join ls
Left Space:ls -> join ls
Left Capit:ls ->
case join ls of
next:ls' -> T.toUpper (T.take 1 next) `T.append` T.drop 1 next : ls'
_ -> []
Left AllCapit:ls ->
case join ls of
next:ls' -> T.toUpper next : ls'
_ -> []
Left (Missing cid):ls -> join (Right (T.pack (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 Text]
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 (`T.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 ++ " " ++ T.unpack 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

View File

@@ -1,383 +0,0 @@
# 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
### Honing in
```
stack build --test --bench --no-run-tests --no-run-benchmarks &&
stack bench --benchmark-arguments "compile lpgf testsuite/lpgf/phrasebook/PhrasebookFre.gf +RTS -T -RTS"
```
**Baseline PGF**
- compile: 1.600776s
- size: 2.88 MB Phrasebook.pgf
Max memory: 328.20 MB
**Baseline LPGF = B**
- compile: 12.401099s
- size: 3.01 MB Phrasebook.lpgf
Max memory: 1.33 GB
**Baseline LPGF String**
- compile: 12.124689s
- size: 3.01 MB Phrasebook.lpgf
Max memory: 1.34 GB
**B -extractStrings**
- compile: 13.822735s
- size: 5.78 MB Phrasebook.lpgf
Max memory: 1.39 GB
**B -cleanupRecordFields**
- compile: 13.670776s
- size: 3.01 MB Phrasebook.lpgf
Max memory: 1.48 GB
**No generation at all = E**
- compile: 0.521001s
- size: 3.27 KB Phrasebook.lpgf
Max memory: 230.69 MB
**+ Concat, Literal, Error, Predef, Tuple, Variant, Commented**
- compile: 1.503594s
- size: 3.27 KB Phrasebook.lpgf
Max memory: 395.31 MB
**+ Var, Pre, Selection**
- compile: 1.260184s
- size: 3.28 KB Phrasebook.lpgf
Max memory: 392.17 MB
**+ Record**
- compile: 1.659233s
- size: 7.07 KB Phrasebook.lpgf
Max memory: 397.41 MB
**+ Projection = X**
- compile: 1.446217s
- size: 7.94 KB Phrasebook.lpgf
Max memory: 423.62 MB
**X + Param**
- compile: 2.073838s
- size: 10.82 KB Phrasebook.lpgf
Max memory: 619.71 MB
**X + Table**
- compile: 11.26558s
- size: 2.48 MB Phrasebook.lpgf
Max memory: 1.15 GB
### Repeated terms in compilation
**Param and Table**
| Concr | Total | Unique | Perc |
|:--------------|-------:|-------:|-----:|
| PhrasebookEng | 8673 | 1724 | 20% |
| PhrasebookSwe | 14802 | 2257 | 15% |
| PhrasebookFin | 526225 | 4866 | 1% |
**Param**
| Concr | Total | Unique | Perc |
|:--------------|-------:|-------:|-----:|
| PhrasebookEng | 3211 | 78 | 2% |
| PhrasebookSwe | 7567 | 69 | 1% |
| PhrasebookFin | 316355 | 310 | 0.1% |
**Table**
| Concr | Total | Unique | Perc |
|:--------------|-------:|-------:|-----:|
| PhrasebookEng | 5470 | 1654 | 30% |
| PhrasebookSwe | 7243 | 2196 | 30% |
| PhrasebookFin | 209878 | 4564 | 2% |
### After impelementing state monad for table memoisation
**worse!**
- compile: 12.55848s
- size: 3.01 MB Phrasebook.lpgf
Max memory: 2.25 GB
**Params**
| Concr | Total | Misses | Perc |
|:--------------|-------:|-------:|------:|
| PhrasebookEng | 3211 | 72 | 2% |
| PhrasebookSwe | 7526 | 61 | 1% |
| PhrasebookFin | 135268 | 333 | 0.2% |
| PhrasebookFre | 337102 | 76 | 0.02% |
_modify instead of insert_
| Concr | Total | Misses | Perc |
|:--------------|-------:|-------:|------:|
| PhrasebookEng | 3211 | 70 | 2% |
| PhrasebookSwe | 7526 | 61 | 1% |
| PhrasebookFin | 135268 | 302 | 0.2% |
| PhrasebookFre | 337102 | 72 | 0.02% |
**Tables**
| Concr | Total | Misses | Perc |
|:--------------|------:|-------:|-----:|
| PhrasebookEng | 3719 | 3170 | 85% |
| PhrasebookSwe | 4031 | 3019 | 75% |
| PhrasebookFin | 36875 | 21730 | 59% |
| PhrasebookFre | 41397 | 32967 | 80% |
_modify instead of insert_
| Concr | Total | Misses | Perc |
|:--------------|------:|-------:|-----:|
| PhrasebookEng | 2415 | 1646 | 68% |
| PhrasebookSwe | 3228 | 2188 | 68% |
| PhrasebookFin | 8793 | 4556 | 52% |
| PhrasebookFre | 12490 | 5793 | 46% |
Conclusions:
- map itself requires more memory than acual compilation
- lookup is also as slow as actual compilation
Tried HashMap (deriving Hashable for LinValue), no inprovement.
Using show on LinValue for keys is incredibly slow.
# 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>>

View File

@@ -1,185 +0,0 @@
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.Text (Text)
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] -> [[Text]]
linLPGF lpgf trees =
[ map (LPGF.linearizeConcreteText concr) trees | (_,concr) <- Map.toList (LPGF.concretes lpgf) ]
linLPGF' :: LPGF.LPGF -> [PGF.Expr] -> IO [[Either String Text]]
linLPGF' lpgf trees =
forM (Map.toList (LPGF.concretes lpgf)) $ \(_,concr) -> mapM (LPGF.try . LPGF.linearizeConcreteText 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)

View File

@@ -1,13 +0,0 @@
--# -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"|"è"|"ì") ;
}

View File

@@ -1,13 +0,0 @@
--# -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"|"é"|"í") ;
}

File diff suppressed because it is too large Load Diff

View File

@@ -1,15 +0,0 @@
-- (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 ;
}

View File

@@ -1,185 +0,0 @@
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: وہ فضول اٹا لوی پیزہ مہنگا ہے

View File

@@ -1,5 +0,0 @@
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

View File

@@ -1,77 +0,0 @@
-- (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
};
}

View File

@@ -1,21 +0,0 @@
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 = "አስቀያሚ";
}

View File

@@ -1,43 +0,0 @@
-- (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 => "еднообразни"}};
}

View File

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

View File

@@ -1,56 +0,0 @@
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 } ;
}

View File

@@ -1,35 +0,0 @@
-- (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" ;
}

View File

@@ -1,58 +0,0 @@
-- (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"};
}

View File

@@ -1,43 +0,0 @@
-- (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"} ;
}

View File

@@ -1,48 +0,0 @@
-- (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" ;
}

View File

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

View File

@@ -1,31 +0,0 @@
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") ;
}

View File

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

View File

@@ -1,67 +0,0 @@
--# -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)}
} ;
}

View File

@@ -1,60 +0,0 @@
--# -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)}
} ;
}

View File

@@ -1,107 +0,0 @@
--(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

View File

@@ -1,75 +0,0 @@
-- (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 => "हैं"
} ;
}

View File

@@ -1,29 +0,0 @@
-- (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 ;
}

View File

@@ -1,83 +0,0 @@
-- (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"
} ;
}

View File

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

View File

@@ -1,71 +0,0 @@
-- (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 => \\_ => "です" } ;
}

View File

@@ -1,76 +0,0 @@
--# -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 };
}

View File

@@ -1,90 +0,0 @@
-- (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
}
} ;
}

View File

@@ -1,120 +0,0 @@
-- (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;
}

View File

@@ -1,105 +0,0 @@
-- (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
} ;
}

View File

@@ -1,48 +0,0 @@
-- (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 + "нууд"}
} ;
}

View File

@@ -1,60 +0,0 @@
-- (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 => "छन्"} ;
}

View File

@@ -1,30 +0,0 @@
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 = "ଅରୁଚିକର";
}

View File

@@ -1,65 +0,0 @@
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 => "هستند"};
}

View File

@@ -1,78 +0,0 @@
-- (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"} ;
}

View File

@@ -1,72 +0,0 @@
-- (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
};
}

View File

@@ -1,30 +0,0 @@
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") ;
}

View File

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

View File

@@ -1,32 +0,0 @@
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 "น่า" "เบิ่อ")) ;
}

View File

@@ -1,177 +0,0 @@
-- (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"}}
};
}

View File

@@ -1,140 +0,0 @@
{-
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
} ;
}

View File

@@ -1,53 +0,0 @@
-- (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
}
};
}

View File

@@ -1,15 +0,0 @@
-- (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 ;
}

View File

@@ -1,18 +0,0 @@
-- (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" ;
}

View File

@@ -1,21 +0,0 @@
-- (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ä" ;
}

View File

@@ -1,17 +0,0 @@
-- (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" ;
}

View File

@@ -1,16 +0,0 @@
-- (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" ;
}

View File

@@ -1,53 +0,0 @@
-- (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" } } };
}

View File

@@ -1,17 +0,0 @@
-- (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" ;
}

View File

@@ -1,53 +0,0 @@
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
};
}

View File

@@ -1,92 +0,0 @@
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
};
}

View File

@@ -1,46 +0,0 @@
-- (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"} ;
}

View File

@@ -1,27 +0,0 @@
#!/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"

View File

@@ -1,28 +0,0 @@
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 ;
}

View File

@@ -1,31 +0,0 @@
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 "колко е часът" ;
}

View File

@@ -1,31 +0,0 @@
--# -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" ;
}

View File

@@ -1,33 +0,0 @@
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 "现在是什么时候" ;
}

View File

@@ -1,29 +0,0 @@
--# -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" ;
}

View File

@@ -1,30 +0,0 @@
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" ;
}

View File

@@ -1,27 +0,0 @@
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" ;
}

View File

@@ -1,26 +0,0 @@
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" ;
}

View File

@@ -1,30 +0,0 @@
--# -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" ;
}

View File

@@ -1,31 +0,0 @@
--# -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" ;
}

View File

@@ -1,31 +0,0 @@
--# -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" ;
}

View File

@@ -1,31 +0,0 @@
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 "कितने बजे हैं" ;
}

View File

@@ -1,31 +0,0 @@
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" ;
}

View File

@@ -1,30 +0,0 @@
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 "今何時ですか" ;
}

View File

@@ -1,33 +0,0 @@
--# -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" ;
}

View File

@@ -1,28 +0,0 @@
--# -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" ;
}

View File

@@ -1,29 +0,0 @@
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 ["موفق باشید"] ;
}

View File

@@ -1,27 +0,0 @@
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" ;
}

View File

@@ -1,31 +0,0 @@
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ă" ;
}

View File

@@ -1,29 +0,0 @@
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 "желаю удачи" ;
}

View File

@@ -1,29 +0,0 @@
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 "قسمت ڀلي هجي" ;
}

View File

@@ -1,31 +0,0 @@
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" ;
}

View File

@@ -1,29 +0,0 @@
--# -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" ;
}

View File

@@ -1,35 +0,0 @@
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 "โชค" "ดี" "นะ") ;
}

View File

@@ -1,29 +0,0 @@
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 "گڈ لك" ;
}

File diff suppressed because it is too large Load Diff

View File

@@ -1,100 +0,0 @@
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))

File diff suppressed because it is too large Load Diff

View File

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

File diff suppressed because it is too large Load Diff

Some files were not shown because too many files have changed in this diff Show More