mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-09 04:59:31 -06:00
Replace Category with Type in the PGF API. Added readLanguage and showLanguage.
This commit is contained in:
@@ -578,7 +578,7 @@ allCommands cod pgf = Map.fromList [
|
||||
lang -> map mkCId (chunks ',' lang)
|
||||
optLang opts = head $ optLangs opts ++ [wildCId]
|
||||
optType opts =
|
||||
let str = valStrOpts "cat" (lookStartCat pgf) opts
|
||||
let str = valStrOpts "cat" (prCId $ lookStartCat pgf) opts
|
||||
in case readType str of
|
||||
Just ty -> ty
|
||||
Nothing -> error ("Can't parse '"++str++"' as type")
|
||||
@@ -595,7 +595,7 @@ allCommands cod pgf = Map.fromList [
|
||||
toString = unwords . toStrings
|
||||
|
||||
prGrammar opts = case opts of
|
||||
_ | isOpt "cats" opts -> unwords $ map prCId $ categories pgf
|
||||
_ | isOpt "cats" opts -> unwords $ map showType $ categories pgf
|
||||
_ | isOpt "fullform" opts -> concatMap
|
||||
(prFullFormLexicon . buildMorpho pgf) $ optLangs opts
|
||||
_ | isOpt "missing" opts ->
|
||||
|
||||
@@ -26,7 +26,7 @@ pgf2js pgf =
|
||||
n = prCId $ absname pgf
|
||||
as = abstract pgf
|
||||
cs = Map.assocs (concretes pgf)
|
||||
start = M.lookStartCat pgf
|
||||
start = prCId $ M.lookStartCat pgf
|
||||
grammar = new "GFGrammar" [js_abstract, js_concrete]
|
||||
js_abstract = abstract2js start as
|
||||
js_concrete = JS.EObj $ map (concrete2js start n) cs
|
||||
|
||||
@@ -31,7 +31,7 @@ toBNF f pgf cnc = prCFG $ f $ pgfToCFG pgf cnc
|
||||
pgfToCFG :: PGF
|
||||
-> CId -- ^ Concrete syntax name
|
||||
-> CFG
|
||||
pgfToCFG pgf lang = mkCFG (lookStartCat pgf) extCats (startRules ++ concatMap fruleToCFRule rules)
|
||||
pgfToCFG pgf lang = mkCFG (prCId (lookStartCat pgf)) extCats (startRules ++ concatMap fruleToCFRule rules)
|
||||
where
|
||||
pinfo = fromMaybe (error "pgfToCFG: No parser.") (lookParser pgf lang)
|
||||
|
||||
|
||||
@@ -32,7 +32,7 @@ grammar2vxml pgf cnc = showsXMLDoc (skel2vxml name language start skel qs) ""
|
||||
name = prCId cnc
|
||||
qs = catQuestions pgf cnc (map fst skel)
|
||||
language = getSpeechLanguage pgf cnc
|
||||
start = mkCId (lookStartCat pgf)
|
||||
start = lookStartCat pgf
|
||||
|
||||
--
|
||||
-- * VSkeleton: a simple description of the abstract syntax.
|
||||
|
||||
@@ -232,7 +232,7 @@ wordCompletion gfenv line0 prefix0 p =
|
||||
pgf = multigrammar cmdEnv
|
||||
cmdEnv = commandenv gfenv
|
||||
optLang opts = valCIdOpts "lang" (head (languages pgf)) opts
|
||||
optType opts = DTyp [] (mkCId (valStrOpts "type" (lookStartCat pgf) opts)) []
|
||||
optType opts = DTyp [] (mkCId (valStrOpts "type" (prCId $ lookStartCat pgf) opts)) []
|
||||
|
||||
ret c [x] = return [x++[c]]
|
||||
ret _ xs = return xs
|
||||
|
||||
31
src/PGF.hs
31
src/PGF.hs
@@ -21,11 +21,13 @@ module PGF(
|
||||
-- ** CId
|
||||
CId, mkCId, prCId, wildCId,
|
||||
|
||||
-- ** Language
|
||||
Language, languages, abstractName, languageCode,
|
||||
-- ** Languages
|
||||
Language,
|
||||
showLanguage, readLanguage,
|
||||
languages, abstractName, languageCode,
|
||||
|
||||
-- ** Category
|
||||
Category, categories, startCat,
|
||||
-- ** Categories
|
||||
categories, startCat,
|
||||
|
||||
-- * Types
|
||||
Type(..),
|
||||
@@ -98,10 +100,9 @@ import Control.Monad
|
||||
-- > concrete LangEng of Lang = ...
|
||||
type Language = CId
|
||||
|
||||
-- | This is just a 'CId' with the category name.
|
||||
-- The categories are defined in the abstract syntax
|
||||
-- with the \'cat\' keyword.
|
||||
type Category = CId
|
||||
readLanguage :: String -> Language
|
||||
|
||||
showLanguage :: Language -> String
|
||||
|
||||
-- | Reads file in Portable Grammar Format and produces
|
||||
-- 'PGF' structure. The file is usually produced with:
|
||||
@@ -184,14 +185,16 @@ languageCode :: PGF -> Language -> Maybe String
|
||||
abstractName :: PGF -> Language
|
||||
|
||||
-- | List of all categories defined in the given grammar.
|
||||
categories :: PGF -> [Category]
|
||||
-- The categories are defined in the abstract syntax
|
||||
-- with the \'cat\' keyword.
|
||||
categories :: PGF -> [Type]
|
||||
|
||||
-- | The start category is defined in the grammar with
|
||||
-- the \'startcat\' flag. This is usually the sentence category
|
||||
-- but it is not necessary. Despite that there is a start category
|
||||
-- defined you can parse with any category. The start category
|
||||
-- definition is just for convenience.
|
||||
startCat :: PGF -> Category
|
||||
startCat :: PGF -> Type
|
||||
|
||||
-- | Complete the last word in the given string. If the input
|
||||
-- is empty or ends in whitespace, the last word is considred
|
||||
@@ -206,6 +209,10 @@ complete :: PGF -> Language -> Type -> String
|
||||
-- Implementation
|
||||
---------------------------------------------------
|
||||
|
||||
readLanguage = mkCId
|
||||
|
||||
showLanguage = prCId
|
||||
|
||||
readPGF f = do
|
||||
s <- readFile f >>= return . decodeUTF8 -- pgf is in UTF8, internal in unicode
|
||||
g <- parseGrammar s
|
||||
@@ -256,9 +263,9 @@ languages pgf = cncnames pgf
|
||||
languageCode pgf lang =
|
||||
fmap (replace '_' '-') $ lookConcrFlag pgf lang (mkCId "language")
|
||||
|
||||
categories pgf = Map.keys (cats (abstract pgf))
|
||||
categories pgf = [DTyp [] c [EMeta i | (Hyp _ _,i) <- zip hs [0..]] | (c,hs) <- Map.toList (cats (abstract pgf))]
|
||||
|
||||
startCat pgf = mkCId (lookStartCat pgf)
|
||||
startCat pgf = DTyp [] (lookStartCat pgf) []
|
||||
|
||||
complete pgf from typ input =
|
||||
let (ws,prefix) = tokensAndPrefix input
|
||||
|
||||
@@ -49,8 +49,8 @@ lookValCat pgf = valCat . lookType pgf
|
||||
lookParser :: PGF -> CId -> Maybe ParserInfo
|
||||
lookParser pgf lang = Map.lookup lang (concretes pgf) >>= parser
|
||||
|
||||
lookStartCat :: PGF -> String
|
||||
lookStartCat pgf = fromMaybe "S" $ msum $ Data.List.map (Map.lookup (mkCId "startcat"))
|
||||
lookStartCat :: PGF -> CId
|
||||
lookStartCat pgf = mkCId $ fromMaybe "S" $ msum $ Data.List.map (Map.lookup (mkCId "startcat"))
|
||||
[gflags pgf, aflags (abstract pgf)]
|
||||
|
||||
lookGlobalFlag :: PGF -> CId -> String
|
||||
|
||||
@@ -50,7 +50,7 @@ pgfMain pgf command =
|
||||
t <- maybe (throwCGIError 400 "No tree given" ["No tree given"]) return mt
|
||||
maybe (throwCGIError 400 "Bad tree" ["Bad tree: " ++ t]) return (PGF.readTree t)
|
||||
|
||||
getCat :: CGI (Maybe PGF.Category)
|
||||
getCat :: CGI (Maybe PGF.Type)
|
||||
getCat =
|
||||
do mcat <- getInput "cat"
|
||||
case mcat of
|
||||
|
||||
Reference in New Issue
Block a user