From 2db5cddc33afde64b5ce9b099cc32cc350f7dc58 Mon Sep 17 00:00:00 2001 From: "kr.angelov" Date: Wed, 4 Jun 2008 07:49:58 +0000 Subject: [PATCH] cleanup, document and export the completion API --- src-3.0/GF/Command/Commands.hs | 13 ++------ src-3.0/PGF.hs | 25 +++++++++++++++ src-3.0/PGF/Parsing/FCFG/Incremental.hs | 41 +++++++++++++++---------- 3 files changed, 52 insertions(+), 27 deletions(-) diff --git a/src-3.0/GF/Command/Commands.hs b/src-3.0/GF/Command/Commands.hs index e35410405..cddecbc9a 100644 --- a/src-3.0/GF/Command/Commands.hs +++ b/src-3.0/GF/Command/Commands.hs @@ -173,21 +173,14 @@ allCommands pgf = Map.fromAscList [ if s == "q" then return () else do cpu1 <- getCPUTime - st <- parse pinfo state0 (words s) - let exps = Incremental.extractExps pinfo (mkCId cat) st + exps <- return $! Incremental.parse pinfo (mkCId cat) (words s) mapM_ (putStrLn . showExp) exps cpu2 <- getCPUTime putStrLn (show ((cpu2 - cpu1) `div` 1000000000) ++ " msec") wordCompletion opts where - parse pinfo st [] = do putStrLnFlush "" - return st - parse pinfo st (t:ts) = do putStrFlush "." - st1 <- return $! (Incremental.nextState pinfo t st) - parse pinfo st1 ts - myCompletion pinfo state0 line prefix p = do let ws = words (take (p-length prefix) line) - state = foldl (\st t -> Incremental.nextState pinfo t st) state0 ws - compls = Incremental.getCompletions pinfo prefix state + state = foldl Incremental.nextState state0 ws + compls = Incremental.getCompletions state prefix return (Map.keys compls) diff --git a/src-3.0/PGF.hs b/src-3.0/PGF.hs index 7a09bef59..49340e043 100644 --- a/src-3.0/PGF.hs +++ b/src-3.0/PGF.hs @@ -37,6 +37,10 @@ module PGF( -- ** Parsing parse, parseAllLang, parseAll, + + -- ** Word Completion (Incremental Parsing) + Incremental.ParseState, + initState, Incremental.nextState, Incremental.getCompletions, extractExps, -- ** Generation generateRandom, generateAll, generateAllDepth @@ -52,6 +56,7 @@ import PGF.Raw.Convert import PGF.Raw.Parse import PGF.Raw.Print (printTree) import PGF.Parsing.FCFG +import qualified PGF.Parsing.FCFG.Incremental as Incremental import GF.Text.UTF8 import GF.Data.ErrM @@ -119,6 +124,16 @@ parseAll :: PGF -> Category -> String -> [[Exp]] -- if the grammar is ambiguous. parseAllLang :: PGF -> Category -> String -> [(Language,[Exp])] +-- | Creates an initial parsing state for a given language and +-- startup category. +initState :: PGF -> Language -> Category -> Incremental.ParseState + +-- | This function extracts the list of all completed parse trees +-- 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. +extractExps :: Incremental.ParseState -> Category -> [Exp] + -- | The same as 'generateAllDepth' but does not limit -- the depth in the generation. generateAll :: PGF -> Category -> [Exp] @@ -183,6 +198,16 @@ parseAll mgr cat = map snd . parseAllLang mgr cat parseAllLang mgr cat s = [(lang,ts) | lang <- languages mgr, let ts = parse mgr lang cat s, not (null ts)] +initState pgf lang cat = Incremental.initState pinfo catCId + where + langCId = mkCId lang + catCId = mkCId cat + pinfo = case lookParser pgf langCId of + Just pinfo -> pinfo + _ -> error ("Unknown language: " ++ lang) + +extractExps state cat = Incremental.extractExps state (mkCId cat) + generateRandom pgf cat = do gen <- newStdGen return $ genRandom gen pgf (mkCId cat) diff --git a/src-3.0/PGF/Parsing/FCFG/Incremental.hs b/src-3.0/PGF/Parsing/FCFG/Incremental.hs index f88af3d35..99387890c 100644 --- a/src-3.0/PGF/Parsing/FCFG/Incremental.hs +++ b/src-3.0/PGF/Parsing/FCFG/Incremental.hs @@ -1,6 +1,6 @@ {-# LANGUAGE BangPatterns #-} module PGF.Parsing.FCFG.Incremental - ( State + ( ParseState , initState , nextState , getCompletions @@ -10,7 +10,7 @@ module PGF.Parsing.FCFG.Incremental import Data.Array import Data.Array.Base (unsafeAt) -import Data.List (isPrefixOf) +import Data.List (isPrefixOf, foldl') import Data.Maybe (fromMaybe) import qualified Data.Map as Map import qualified Data.IntMap as IntMap @@ -26,12 +26,9 @@ import PGF.Parsing.FCFG.Utilities import Debug.Trace parse :: ParserInfo -> CId -> [FToken] -> [Exp] -parse pinfo start toks = go (initState pinfo start) toks - where - go st [] = extractExps pinfo start st - go st (t:ts) = go (nextState pinfo t st) ts +parse pinfo start toks = extractExps (foldl' nextState (initState pinfo start) toks) start -initState :: ParserInfo -> CId -> State +initState :: ParserInfo -> CId -> ParseState initState pinfo start = let items = do c <- Map.findWithDefault [] start (startupCats pinfo) @@ -46,39 +43,47 @@ initState pinfo start = Just ((fid,_), _) -> fid+1 Nothing -> 0 - in State (Chart MM.empty [] Map.empty forest max_fid 0) + in State pinfo + (Chart MM.empty [] Map.empty forest max_fid 0) (Set.fromList items) -nextState :: ParserInfo -> FToken -> State -> State -nextState pinfo t (State chart items) = +-- | From the current state and the next token +-- 'nextState' computes a new state where the token +-- is consumed and the current position shifted by one. +nextState :: ParseState -> String -> ParseState +nextState (State pinfo chart items) t = let (items1,chart1) = process add (allRules pinfo) (Set.toList items) (Set.empty,chart) chart2 = chart1{ active =MM.empty , actives=active chart1 : actives chart1 , passive=Map.empty , offset =offset chart1+1 } - in State chart2 items1 + in State pinfo chart2 items1 where add tok item set | tok == t = Set.insert item set | otherwise = set -getCompletions :: ParserInfo -> FToken -> State -> Map.Map FToken State -getCompletions pinfo w (State chart items) = +-- | If the next token is not known but only its prefix (possible empty prefix) +-- then the 'getCompletions' function can be used to calculate the possible +-- next words and the consequent states. This is used for word completions in +-- the GF interpreter. +getCompletions :: ParseState -> String -> Map.Map String ParseState +getCompletions (State pinfo chart items) w = let (map',chart1) = process add (allRules pinfo) (Set.toList items) (MM.empty,chart) chart2 = chart1{ active =MM.empty , actives=active chart1 : actives chart1 , passive=Map.empty , offset =offset chart1+1 } - in fmap (State chart2) map' + in fmap (State pinfo chart2) map' where add tok item map | isPrefixOf w tok = fromMaybe map (MM.insert' tok item map) | otherwise = map -extractExps :: ParserInfo -> CId -> State -> [Exp] -extractExps pinfo start (State chart items) = exps +extractExps :: ParseState -> CId -> [Exp] +extractExps (State pinfo chart items) start = exps where (_,st) = process (\_ _ -> id) (allRules pinfo) (Set.toList items) ((),chart) @@ -160,7 +165,9 @@ data PassiveKey deriving (Eq,Ord,Show) -data State = State Chart (Set.Set Active) +-- | An abstract data type whose values represent +-- the current state in an incremental parser. +data ParseState = State ParserInfo Chart (Set.Set Active) data Chart = Chart