From 88d7631b62fd004ac4d84d37cc94a133f0776f60 Mon Sep 17 00:00:00 2001 From: krasimir Date: Tue, 22 Jun 2010 12:31:04 +0000 Subject: [PATCH] preliminary version of API for Open Literals --- src/runtime/haskell/PGF.hs | 1 + src/runtime/haskell/PGF/Parse.hs | 51 +++++++++++++++++++++++++++----- 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 }