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