msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

added explicit depth parameter to the parsing API and the corresponding command in the shell

Browse Source
This commit is contained in:
krasimir
2010-10-18 16:51:25 +00:00
parent 205ac48ac3
commit 775e59dabe
5 changed files with 35 additions and 32 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
src/compiler/GF/Command/Commands.hs
View File

@@ -492,7 +492,8 @@ allCommands env@(pgf, mos) = Map.fromList [
flags = [
("cat","target category of parsing"),
("lang","the languages of parsing (comma-separated, no spaces)"),
("openclass","list of open-class categories for robust parsing")
("openclass","list of open-class categories for robust parsing"),
("depth","maximal depth for proof search if the abstract syntax tree has meta variables")
],
options = [
("bracket","prints the bracketed string from the parser")
@@ -902,8 +903,10 @@ allCommands env@(pgf, mos) = Map.fromList [
]
where
par opts s = case optOpenTypes opts of
[] -> [parse_ pgf lang (optType opts) s | lang <- optLangs opts]
open_typs -> [parseWithRecovery pgf lang (optType opts) open_typs s | lang <- optLangs opts]
[] -> [parse_ pgf lang (optType opts) (Just dp) s | lang <- optLangs opts]
open_typs -> [parseWithRecovery pgf lang (optType opts) open_typs (Just dp) s | lang <- optLangs opts]
where
dp = valIntOpts "depth" 4 opts
void = ([],[])
@@ -993,7 +996,7 @@ allCommands env@(pgf, mos) = Map.fromList [
Just ty -> case checkType pgf ty of
Left tcErr -> error $ render (ppTcError tcErr)
Right ty -> ty
Nothing -> error ("Can't parse '"++str++"' as type")
Nothing -> error ("Can't parse '"++str++"' as a type")
optComm opts = valStrOpts "command" "" opts
optViewFormat opts = valStrOpts "format" "png" opts
optViewGraph opts = valStrOpts "view" "open" opts

2
src/compiler/GF/Compile/ExampleBased.hs
View File

@@ -41,7 +41,7 @@ convertFile conf src file = do
convEx (cat,ex) = do
appn "("
let typ = maybe (error "no valid cat") id $ readType cat
ws <- case fst (parse_ pgf lang typ ex) of
ws <- case fst (parse_ pgf lang typ (Just 4) ex) of
ParseFailed _ -> do
let ws = morphoMissing morpho (words ex)
appv ("WARNING: cannot parse example " ++ ex)

14
src/runtime/haskell/PGF.hs
View File

@@ -182,10 +182,10 @@ parseAll :: PGF -> Type -> String -> [[Tree]]
parseAllLang :: PGF -> Type -> String -> [(Language,[Tree])]
-- | The same as 'parse' but returns more detailed information
parse_ :: PGF -> Language -> Type -> String -> (Parse.ParseOutput,BracketedString)
parse_ :: PGF -> Language -> Type -> Maybe Int -> String -> (Parse.ParseOutput,BracketedString)
-- | This is an experimental function. Use it on your own risk
parseWithRecovery :: PGF -> Language -> Type -> [Type] -> String -> (Parse.ParseOutput,BracketedString)
parseWithRecovery :: PGF -> Language -> Type -> [Type] -> Maybe Int -> String -> (Parse.ParseOutput,BracketedString)
-- | List of all languages available in the given grammar.
languages :: PGF -> [Language]
@@ -227,21 +227,21 @@ functionType :: PGF -> CId -> Maybe Type
readPGF f = decodeFile f
parse pgf lang typ s =
case parse_ pgf lang typ s of
case parse_ pgf lang typ (Just 4) s of
(Parse.ParseOk ts,_) -> ts
_ -> []
parseAll mgr typ = map snd . parseAllLang mgr typ
parseAllLang mgr typ s =
[(lang,ts) | lang <- languages mgr, (Parse.ParseOk ts,_) <- [parse_ mgr lang typ s]]
[(lang,ts) | lang <- languages mgr, (Parse.ParseOk ts,_) <- [parse_ mgr lang typ (Just 4) s]]
parse_ pgf lang typ s =
parse_ pgf lang typ dp s =
case Map.lookup lang (concretes pgf) of
Just cnc -> Parse.parse pgf lang typ (words s)
Just cnc -> Parse.parse pgf lang typ dp (words s)
Nothing -> error ("Unknown language: " ++ showCId lang)
parseWithRecovery pgf lang typ open_typs s = Parse.parseWithRecovery pgf lang typ open_typs (words s)
parseWithRecovery pgf lang typ open_typs dp s = Parse.parseWithRecovery pgf lang typ open_typs dp (words s)
groupResults :: [[(Language,String)]] -> [(Language,[String])]
groupResults = Map.toList . foldr more Map.empty . start . concat

16
src/runtime/haskell/PGF/Forest.hs
View File

@@ -47,16 +47,16 @@ data Forest
-- Rendering of bracketed strings
--------------------------------------------------------------------
linearizeWithBrackets :: Forest -> BracketedString
linearizeWithBrackets = head . snd . untokn "" . bracketedTokn
linearizeWithBrackets :: Maybe Int -> Forest -> BracketedString
linearizeWithBrackets dp = head . snd . untokn "" . bracketedTokn dp
---------------------------------------------------------------
-- Internally we have to do everything with Tokn first because
-- we must handle the pre {...} construction.
--
bracketedTokn :: Forest -> BracketedTokn
bracketedTokn f@(Forest abs cnc forest root) =
bracketedTokn :: Maybe Int -> Forest -> BracketedTokn
bracketedTokn dp f@(Forest abs cnc forest root) =
case [computeSeq isTrusted seq (map (render forest) args) | (seq,args) <- root] of
([bs@(Bracket_ _ _ _ _ _)]:_) -> bs
(bss:_) -> Bracket_ wildCId 0 0 [] bss
@@ -79,7 +79,7 @@ bracketedTokn f@(Forest abs cnc forest root) =
Just (DTyp _ cat _,_,_,_) -> cat
largs = map (render forest) args
ltable = mkLinTable cnc isTrusted [] funid largs
in ((cat,fid),either (const []) id $ getAbsTrees f arg Nothing,ltable)
in ((cat,fid),either (const []) id $ getAbsTrees f arg Nothing dp,ltable)
descend forest (PCoerce fid) = render forest (PArg [] fid)
descend forest (PConst cat e ts) = ((cat,fid),[e],([],listArray (0,0) [[LeafKS ts]]))
@@ -116,10 +116,10 @@ isLindefCId id
-- that spans the whole input consumed so far. The trees are also
-- limited by the category specified, which is usually
-- the same as the startup category.
getAbsTrees :: Forest -> PArg -> Maybe Type -> Either [(FId,TcError)] [Expr]
getAbsTrees (Forest abs cnc forest root) arg@(PArg _ fid) ty =
getAbsTrees :: Forest -> PArg -> Maybe Type -> Maybe Int -> Either [(FId,TcError)] [Expr]
getAbsTrees (Forest abs cnc forest root) arg@(PArg _ fid) ty dp =
let (err,res) = runTcM abs (do e <- go Set.empty emptyScope (fmap (TTyp []) ty) arg
generateForForest (prove (Just 20)) e) fid IntMap.empty
generateForForest (prove dp) e) fid IntMap.empty
in if null res
then Left (nub err)
else Right (nubsort [e | (_,_,e) <- res])

24
src/runtime/haskell/PGF/Parse.hs
View File

@@ -52,25 +52,25 @@ data ParseOutput
-- The list should be non-empty.
| ParseIncomplete -- ^ The sentence is not complete. Only partial output is produced
parse :: PGF -> Language -> Type -> [Token] -> (ParseOutput,BracketedString)
parse pgf lang typ toks = loop (initState pgf lang typ) toks
parse :: PGF -> Language -> Type -> Maybe Int -> [Token] -> (ParseOutput,BracketedString)
parse pgf lang typ dp toks = loop (initState pgf lang typ) toks
where
loop ps [] = getParseOutput ps typ
loop ps [] = getParseOutput ps typ dp
loop ps (t:ts) = case nextState ps (simpleParseInput t) of
Left es -> case es of
EState _ _ chart -> (ParseFailed (offset chart),snd (getParseOutput ps typ))
EState _ _ chart -> (ParseFailed (offset chart),snd (getParseOutput ps typ dp))
Right ps -> loop ps ts
parseWithRecovery :: PGF -> Language -> Type -> [Type] -> [String] -> (ParseOutput,BracketedString)
parseWithRecovery pgf lang typ open_typs toks = accept (initState pgf lang typ) toks
parseWithRecovery :: PGF -> Language -> Type -> [Type] -> Maybe Int -> [String] -> (ParseOutput,BracketedString)
parseWithRecovery pgf lang typ open_typs dp toks = accept (initState pgf lang typ) toks
where
accept ps [] = getParseOutput ps typ
accept ps [] = getParseOutput ps typ dp
accept ps (t:ts) =
case nextState ps (simpleParseInput t) of
Right ps -> accept ps ts
Left es -> skip (recoveryStates open_typs es) ts
skip ps_map [] = getParseOutput (fst ps_map) typ
skip ps_map [] = getParseOutput (fst ps_map) typ dp
skip ps_map (t:ts) =
case Map.lookup t (snd ps_map) of
Just ps -> accept ps ts
@@ -210,19 +210,19 @@ recoveryStates open_types (EState pgf cnc chart) =
-- that spans the whole input consumed so far. The trees are also
-- limited by the category specified, which is usually
-- the same as the startup category.
getParseOutput :: ParseState -> Type -> (ParseOutput,BracketedString)
getParseOutput (PState pgf cnc chart items) ty@(DTyp _ start _) =
getParseOutput :: ParseState -> Type -> Maybe Int -> (ParseOutput,BracketedString)
getParseOutput (PState pgf cnc chart items) ty@(DTyp _ start _) dp =
let froots | null roots = getPartialSeq (sequences cnc) (reverse (active chart1 : actives chart1)) seq
| otherwise = [([SymCat 0 lbl],[PArg [] fid]) | AK fid lbl <- roots]
f = Forest (abstract pgf) cnc (forest chart1) froots
bs = linearizeWithBrackets f
bs = linearizeWithBrackets dp f
res | not (null es) = ParseOk es
| not (null errs) = TypeError errs
| otherwise = ParseIncomplete
where xs = [getAbsTrees f (PArg [] fid) (Just ty) | (AK fid lbl) <- roots]
where xs = [getAbsTrees f (PArg [] fid) (Just ty) dp | (AK fid lbl) <- roots]
es = concat [es | Right es <- xs]
errs = concat [errs | Left errs <- xs]