From 775e59dabeb6d1e15a3c1c80d7578a865121b9cf Mon Sep 17 00:00:00 2001 From: krasimir Date: Mon, 18 Oct 2010 16:51:25 +0000 Subject: added explicit depth parameter to the parsing API and the corresponding command in the shell --- src/runtime/haskell/PGF.hs | 14 +++++++------- src/runtime/haskell/PGF/Forest.hs | 16 ++++++++-------- src/runtime/haskell/PGF/Parse.hs | 24 ++++++++++++------------ 3 files changed, 27 insertions(+), 27 deletions(-) (limited to 'src/runtime') 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] -- cgit v1.2.3