preliminary version of API for Open Literals

2 files changed, 45 insertions, 7 deletions

diff --git a/src/runtime/haskell/PGF.hs b/src/runtime/haskell/PGF.hs
index 128a58a35..2f9f21e1e 100644
--- a/src/runtime/haskell/PGF.hs
+++ b/src/runtime/haskell/PGF.hs
@@ -80,6 +80,7 @@ module PGF(
            complete,
            Parse.ParseState,
            Parse.initState, Parse.nextState, Parse.getCompletions, Parse.recoveryStates, 
+           Parse.acceptsLiteral, Parse.feedLiteral,
            Parse.ParseResult(..), Parse.getParseResult,
 
            -- ** Generation
diff --git a/src/runtime/haskell/PGF/Parse.hs b/src/runtime/haskell/PGF/Parse.hs
index 1e4c2cdde..0f3a885e5 100644
--- a/src/runtime/haskell/PGF/Parse.hs
+++ b/src/runtime/haskell/PGF/Parse.hs
@@ -5,6 +5,8 @@ module PGF.Parse
           , initState

           , nextState

           , getCompletions

+          , acceptsLiteral

+          , feedLiteral

           , recoveryStates

           , ParseResult(..), getParseResult

           , parse

@@ -92,7 +94,7 @@ nextState (PState pgf cnc chart items) t =
   let (mb_agenda,map_items) = TMap.decompose items

       agenda = maybe [] Set.toList mb_agenda

       acc    = fromMaybe TMap.empty (Map.lookup t map_items)

-      (acc1,chart1) = process (Just t) add (sequences cnc) (cncfuns cnc) agenda acc chart

+      (acc1,chart1) = process (litCatMatch (Just t)) add (sequences cnc) (cncfuns cnc) agenda acc chart

       chart2 = chart1{ active =emptyAC

                      , actives=active chart1 : actives chart1

                      , passive=emptyPC

@@ -106,6 +108,41 @@ nextState (PState pgf cnc chart items) t =
       | tok == t            = TMap.insertWith Set.union toks (Set.singleton item) acc

     add _          item acc = acc

 

+acceptsLiteral :: ParseState -> Type -> Bool

+acceptsLiteral (PState pgf cnc chart items) (DTyp _ cat _) =

+  case Map.lookup cat (cnccats cnc) of

+    Just (CncCat s e _) -> or [IntMap.member fid (active chart1) | fid <- [s..e]]

+    Nothing             -> False

+  where

+    (mb_agenda,map_items) = TMap.decompose items

+    agenda = maybe [] Set.toList mb_agenda

+    (acc1,chart1) = process (litCatMatch Nothing) add (sequences cnc) (cncfuns cnc) agenda TMap.empty chart

+

+    add (tok:toks) item acc = acc

+

+feedLiteral :: ParseState -> Expr -> Either ErrorState ParseState

+feedLiteral (PState pgf cnc chart items) (ELit lit) =

+  let (mb_agenda,map_items) = TMap.decompose items

+      agenda = maybe [] Set.toList mb_agenda

+      (acc1,chart1) = process (magic lit) add (sequences cnc) (cncfuns cnc) agenda TMap.empty chart

+      chart2 = chart1{ active =emptyAC

+                     , actives=active chart1 : actives chart1

+                     , passive=emptyPC

+                     , offset =offset chart1+1

+                     }

+  in if TMap.null acc1

+       then Left  (EState pgf cnc chart2)

+       else Right (PState pgf cnc chart2 acc1)

+  where

+    add toks item acc = TMap.insertWith Set.union toks (Set.singleton item) acc

+

+    magic lit fid =

+      case lit of

+        LStr s | fid == fcatString -> Just (cidString, ELit lit, words s)

+        LInt n | fid == fcatInt    -> Just (cidInt,    ELit lit, [show n])

+        LFlt d | fid == fcatFloat  -> Just (cidFloat,  ELit lit, [show d])

+        _                          -> Nothing

+

 -- | 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

@@ -115,7 +152,7 @@ getCompletions (PState pgf cnc chart items) w =
   let (mb_agenda,map_items) = TMap.decompose items

       agenda = maybe [] Set.toList mb_agenda

       acc    = Map.filterWithKey (\tok _ -> isPrefixOf w tok) map_items

-      (acc',chart1) = process Nothing add (sequences cnc) (cncfuns cnc) agenda acc chart

+      (acc',chart1) = process (litCatMatch Nothing) add (sequences cnc) (cncfuns cnc) agenda acc chart

       chart2 = chart1{ active =emptyAC

                      , actives=active chart1 : actives chart1

                      , passive=emptyPC

@@ -131,7 +168,7 @@ recoveryStates :: [Type] -> ErrorState -> (ParseState, Map.Map String ParseState
 recoveryStates open_types (EState pgf cnc chart) =

   let open_fcats = concatMap type2fcats open_types

       agenda = foldl (complete open_fcats) [] (actives chart)

-      (acc,chart1) = process Nothing add (sequences cnc) (cncfuns cnc) agenda Map.empty chart

+      (acc,chart1) = process (litCatMatch Nothing) add (sequences cnc) (cncfuns cnc) agenda Map.empty chart

       chart2 = chart1{ active =emptyAC

                      , actives=active chart1 : actives chart1

                      , passive=emptyPC

@@ -178,7 +215,7 @@ getParseResult (PState pgf cnc chart items) ty@(DTyp _ start _) =
   where

     (mb_agenda,acc) = TMap.decompose items

     agenda = maybe [] Set.toList mb_agenda

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

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

 

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

       where

@@ -269,7 +306,7 @@ process mbt fn !seqs !funs (item@(Active j ppos funid seqid args key0):items) ac
                       in case [ts | PConst _ _ ts <- maybe [] Set.toList (IntMap.lookup fid' (forest chart))] of

                            (toks:_) -> let !acc' = fn toks (Active j (ppos+1) funid seqid (updateAt d fid' args) key0) acc

                                        in process mbt fn seqs funs items acc' chart

-                           []       -> case litCatMatch fid mbt of

+                           []       -> case mbt fid of

                                          Just (cat,lit,toks) 

                                                      -> let fid'  = nextId chart

                                                             !acc' = fn toks (Active j (ppos+1) funid seqid (updateAt d fid' args) key0) acc

@@ -277,7 +314,7 @@ process mbt fn !seqs !funs (item@(Active j ppos funid seqid args key0):items) ac
                                                                                                     ,forest =IntMap.insert fid' (Set.singleton (PConst cat lit toks)) (forest chart)

                                                                                                     ,nextId =nextId chart+1

                                                                                                     }

-                                         Nothing     -> process mbt fn seqs funs items acc chart

+                                         Nothing     -> process mbt fn seqs funs items acc chart{active=insertAC key (Set.singleton item) (active chart)}

   | otherwise =

       case lookupPC (mkPK key0 j) (passive chart) of

         Nothing -> let fid = nextId chart

@@ -307,7 +344,7 @@ process mbt fn !seqs !funs (item@(Active j ppos funid seqid args key0):items) ac
 updateAt :: Int -> a -> [a] -> [a]

 updateAt nr x xs = [if i == nr then x else y | (i,y) <- zip [0..] xs]

 

-litCatMatch fcat (Just t)

+litCatMatch (Just t) fcat

   | fcat == fcatString = Just (cidString,ELit (LStr t),[t])

   | fcat == fcatInt    = case reads t of {[(n,"")] -> Just (cidInt,ELit (LInt n),[t]);

                                          _         -> Nothing }