From 51452d4ef01608ab86cabb953755c586806ed1bc Mon Sep 17 00:00:00 2001 From: krasimir Date: Mon, 18 Oct 2010 16:51:25 +0000 Subject: [PATCH] added explicit depth parameter to the parsing API and the corresponding command in the shell --- src/compiler/GF/Command/Commands.hs | 11 +++++++---- src/compiler/GF/Compile/ExampleBased.hs | 2 +- src/runtime/haskell/PGF.hs | 14 +++++++------- src/runtime/haskell/PGF/Forest.hs | 16 ++++++++-------- src/runtime/haskell/PGF/Parse.hs | 24 ++++++++++++------------ 5 files changed, 35 insertions(+), 32 deletions(-) diff --git a/src/compiler/GF/Command/Commands.hs b/src/compiler/GF/Command/Commands.hs index d27bea37e..b10d35ec7 100644 --- a/src/compiler/GF/Command/Commands.hs +++ b/src/compiler/GF/Command/Commands.hs @@ -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 diff --git a/src/compiler/GF/Compile/ExampleBased.hs b/src/compiler/GF/Compile/ExampleBased.hs index 46fb8b5d7..24944d9b6 100644 --- a/src/compiler/GF/Compile/ExampleBased.hs +++ b/src/compiler/GF/Compile/ExampleBased.hs @@ -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) diff --git a/src/runtime/haskell/PGF.hs b/src/runtime/haskell/PGF.hs index c750e66fe..9165f01ef 100644 --- a/src/runtime/haskell/PGF.hs +++ b/src/runtime/haskell/PGF.hs @@ -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 diff --git a/src/runtime/haskell/PGF/Forest.hs b/src/runtime/haskell/PGF/Forest.hs index 97cfbfa21..af8ccc5e4 100644 --- a/src/runtime/haskell/PGF/Forest.hs +++ b/src/runtime/haskell/PGF/Forest.hs @@ -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]) diff --git a/src/runtime/haskell/PGF/Parse.hs b/src/runtime/haskell/PGF/Parse.hs index 3ed3d7a72..7c5b1a22f 100644 --- a/src/runtime/haskell/PGF/Parse.hs +++ b/src/runtime/haskell/PGF/Parse.hs @@ -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]