now the parser could return partial parse results

1 files changed, 38 insertions, 13 deletions

diff --git a/src/runtime/haskell/PGF/Parse.hs b/src/runtime/haskell/PGF/Parse.hs
index 9ae28bdab..ce195f752 100644
--- a/src/runtime/haskell/PGF/Parse.hs
+++ b/src/runtime/haskell/PGF/Parse.hs
@@ -38,16 +38,16 @@ data ParseResult
                                    -- if there are many analizes for some phrase but they all are not type correct.

   | ParseResult [Tree]             -- ^ If the parsing was successful we get a list of abstract syntax trees. The list should be non-empty.

 

-parse :: PGF -> Language -> Type -> [String] -> (ParseResult,Maybe BracketedString)

+parse :: PGF -> Language -> Type -> [String] -> (ParseResult,BracketedString)

 parse pgf lang typ toks = loop (initState pgf lang typ) toks

   where

     loop ps []     = getParseResult ps typ

     loop ps (t:ts) = case nextState ps t of

                        Left  es -> case es of

-                                     EState _ _ chart -> (ParseFailed (offset chart),Nothing)

+                                     EState _ _ chart -> (ParseFailed (offset chart),snd (getParseResult ps typ))

                        Right ps -> loop ps ts

 

-parseWithRecovery :: PGF -> Language -> Type -> [Type] -> [String] -> (ParseResult,Maybe BracketedString)

+parseWithRecovery :: PGF -> Language -> Type -> [Type] -> [String] -> (ParseResult,BracketedString)

 parseWithRecovery pgf lang typ open_typs toks = accept (initState pgf lang typ) toks

   where

     accept ps []     = getParseResult ps typ

@@ -155,11 +155,13 @@ 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.

-getParseResult :: ParseState -> Type -> (ParseResult,Maybe BracketedString)

+getParseResult :: ParseState -> Type -> (ParseResult,BracketedString)

 getParseResult (PState pgf cnc chart items) ty@(DTyp _ start _) =

-  let mb_bs = case roots of

-                ((AK fid lbl):_) -> Just $ linearizeWithBrackets $ Forest (abstract pgf) cnc (forest st) fid lbl

-                _                -> Nothing

+  let froots | null roots = getPartialSeq (sequences cnc) (reverse (active st : actives st)) acc1

+             | otherwise  = [([SymCat 0 lbl],[fid]) | AK fid lbl <- roots]

+

+      bs    = linearizeWithBrackets (Forest (abstract pgf) cnc (forest st) froots)

+              

                 

       exps  = nubsort $ do

                 (AK fid lbl) <- roots

@@ -172,11 +174,15 @@ getParseResult (PState pgf cnc chart items) ty@(DTyp _ start _) =
                 then ParseFailed (offset chart)

                 else ParseResult exps

 

-  in (res,mb_bs)

+  in (res,bs)

   where

     (mb_agenda,acc) = TMap.decompose items

     agenda = maybe [] Set.toList mb_agenda

-    (_,st) = process Nothing (\_ _ -> id) (sequences cnc) (cncfuns cnc) agenda () chart

+    (acc1,st) = process Nothing add (sequences cnc) (cncfuns cnc) agenda [] chart

+

+    add _ (Active j ppos funid seqid args key) items = (j,lin,args,key) : items

+      where

+        lin  = take (ppos-1) (elems (unsafeAt (sequences cnc) seqid))

 

     roots = case Map.lookup start (cnccats cnc) of

               Just (CncCat s e lbls) -> do cat <- range (s,e)

@@ -187,18 +193,18 @@ getParseResult (PState pgf cnc chart items) ty@(DTyp _ start _) =
 

     go rec fcat' (d,fcat)

       | fcat < totalCats cnc = return (Set.empty,EMeta (fcat'*10+d))   -- FIXME: here we assume that every rule has at most 10 arguments

-      | Set.member fcat rec    = mzero

-      | otherwise              = foldForest (\funid args trees -> 

+      | Set.member fcat rec  = mzero

+      | otherwise            = foldForest (\funid args trees -> 

                                                   do let CncFun fn lins = cncfuns cnc ! funid

                                                      args <- mapM (go (Set.insert fcat rec) fcat) (zip [0..] args)

                                                      check_ho_fun fn args

                                                   `mplus`

                                                   trees)

-                                            (\const _ trees ->

+                                          (\const _ trees ->

                                                   return (freeVar const,const)

                                                   `mplus`

                                                   trees)

-                                            [] fcat (forest st)

+                                          [] fcat (forest st)

 

     check_ho_fun fun args

       | fun == _V = return (head args)

@@ -211,6 +217,25 @@ getParseResult (PState pgf cnc chart items) ty@(DTyp _ start _) =
     freeVar (EFun v) = Set.singleton v

     freeVar _        = Set.empty

 

+getPartialSeq seqs actives = expand Set.empty

+  where

+    expand acc [] = 

+      [(lin,args) | (j,lin,args,key) <- Set.toList acc, j == 0]

+    expand acc (item@(j,lin,args,key) : items)

+      | item `Set.member` acc = expand acc  items

+      | otherwise             = expand acc' items'

+      where

+        acc'   = Set.insert item acc

+        items' = case lookupAC key (actives !! j) of

+                   Nothing  -> items

+                   Just set -> [if j' < j

+                                  then let lin' = take ppos (elems (unsafeAt seqs seqid))

+                                       in (j',lin'++map (inc (length args')) lin,args'++args,key')

+                                  else (j',lin,args,key') | Active j' ppos funid seqid args' key' <- Set.toList set] ++ items

+

+    inc n (SymCat d r) = SymCat (n+d) r

+    inc n (SymLit d r) = SymLit (n+d) r

+    inc n s            = s

 

 process mbt fn !seqs !funs []                                                 acc chart = (acc,chart)

 process mbt fn !seqs !funs (item@(Active j ppos funid seqid args key0):items) acc chart