cleanup, document and export the completion API

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