GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-06-18 15:50:11 -06:00
Code Issues Packages Projects Releases Wiki Activity

now the datatype Tree is only internal. All API functions are working with Expr directly. Commands gt, gr, p and rf filter out the output via the typechecker

Browse Source
This commit is contained in:
krasimir
2009-09-08 08:40:28 +00:00
parent 9940c44259
commit 28a7c4b5c7
23 changed files with 272 additions and 322 deletions
Download Patch File Download Diff File Expand all files Collapse all files

39
src/PGF/Parsing/FCFG.hs
View File

@@ -1,39 +0,0 @@
----------------------------------------------------------------------
-- |
-- Maintainer : Krasimir Angelov
-- Stability : (stable)
-- Portability : (portable)
--
-- FCFG parsing
-----------------------------------------------------------------------------
module PGF.Parsing.FCFG
(ParserInfo,parseFCFG) where
import GF.Data.ErrM
import GF.Data.Assoc
import GF.Data.SortedList
import PGF.CId
import PGF.Data
import PGF.Macros
import PGF.Parsing.FCFG.Utilities
import qualified PGF.Parsing.FCFG.Active as Active
import qualified PGF.Parsing.FCFG.Incremental as Incremental
import qualified Data.Map as Map
----------------------------------------------------------------------
-- parsing
-- main parsing function
parseFCFG :: String -- ^ parsing strategy
-> ParserInfo -- ^ compiled grammar (fcfg)
-> Type -- ^ start type
-> [String] -- ^ input tokens
-> Err [Tree] -- ^ resulting GF terms
parseFCFG "bottomup" pinfo typ toks = return $ Active.parse "b" pinfo typ toks
parseFCFG "topdown" pinfo typ toks = return $ Active.parse "t" pinfo typ toks
parseFCFG "incremental" pinfo typ toks = return $ Incremental.parse pinfo typ toks
parseFCFG strat pinfo typ toks = fail $ "FCFG parsing strategy not defined: " ++ strat

5
src/PGF/Parsing/FCFG/Active.hs
View File

@@ -16,6 +16,7 @@ import qualified GF.Data.MultiMap as MM
import PGF.CId
import PGF.Data
import PGF.Tree
import PGF.Parsing.FCFG.Utilities
import PGF.BuildParser
@@ -37,8 +38,8 @@ makeFinalEdge cat 0 0 = (cat, [EmptyRange])
makeFinalEdge cat i j = (cat, [makeRange i j])
-- | the list of categories = possible starting categories
parse :: String -> ParserInfo -> Type -> [FToken] -> [Tree]
parse strategy pinfo (DTyp _ start _) toks = nubsort $ filteredForests >>= forest2trees
parse :: String -> ParserInfo -> Type -> [FToken] -> [Expr]
parse strategy pinfo (DTyp _ start _) toks = map (tree2expr) . nubsort $ filteredForests >>= forest2trees
where
inTokens = input toks
starts = Map.findWithDefault [] start (startCats pinfo)

67
src/PGF/Parsing/FCFG/Incremental.hs
View File

@@ -21,13 +21,17 @@ import Control.Monad
import GF.Data.SortedList
import PGF.CId
import PGF.Data
import PGF.Macros
import PGF.TypeCheck
import Debug.Trace
parse :: ParserInfo -> Type -> [String] -> [Tree]
parse pinfo typ toks = maybe [] (\ps -> extractExps ps typ) (foldM nextState (initState pinfo typ) toks)
parse :: PGF -> Language -> Type -> [String] -> [Expr]
parse pgf lang typ toks = maybe [] (\ps -> extractExps ps typ) (foldM nextState (initState pgf lang typ) toks)
initState :: ParserInfo -> Type -> ParseState
initState pinfo (DTyp _ start _) =
-- | Creates an initial parsing state for a given language and
-- startup category.
initState :: PGF -> Language -> Type -> ParseState
initState pgf lang (DTyp _ start _) =
let items = do
cat <- fromMaybe [] (Map.lookup start (startCats pinfo))
(funid,args) <- foldForest (\funid args -> (:) (funid,args)) (\_ _ args -> args)
@@ -35,8 +39,14 @@ initState pinfo (DTyp _ start _) =
let FFun fn _ lins = functions pinfo ! funid
(lbl,seqid) <- assocs lins
return (Active 0 0 funid seqid args (AK cat lbl))
in State pinfo
pinfo =
case lookParser pgf lang of
Just pinfo -> pinfo
_ -> error ("Unknown language: " ++ prCId lang)
in State pgf
pinfo
(Chart emptyAC [] emptyPC (productions pinfo) (totalCats pinfo) 0)
(TMap.singleton [] (Set.fromList items))
@@ -44,7 +54,7 @@ initState pinfo (DTyp _ start _) =
-- 'nextState' computes a new state where the token
-- is consumed and the current position shifted by one.
nextState :: ParseState -> String -> Maybe ParseState
nextState (State pinfo chart items) t =
nextState (State pgf pinfo 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)
@@ -56,7 +66,7 @@ nextState (State pinfo chart items) t =
}
in if TMap.null acc1
then Nothing
else Just (State pinfo chart2 acc1)
else Just (State pgf pinfo chart2 acc1)
where
add (tok:toks) item acc
| tok == t = TMap.insertWith Set.union toks (Set.singleton item) acc
@@ -67,7 +77,7 @@ nextState (State pinfo chart items) t =
-- 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 =
getCompletions (State pgf pinfo 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
@@ -77,20 +87,25 @@ getCompletions (State pinfo chart items) w =
, passive=emptyPC
, offset =offset chart1+1
}
in fmap (State pinfo chart2) acc'
in fmap (State pgf pinfo chart2) acc'
where
add (tok:toks) item acc
| isPrefixOf w tok = Map.insertWith (TMap.unionWith Set.union) tok (TMap.singleton toks (Set.singleton item)) acc
add _ item acc = acc
extractExps :: ParseState -> Type -> [Tree]
extractExps (State pinfo chart items) (DTyp _ start _) = exps
-- | 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 :: ParseState -> Type -> [Expr]
extractExps (State pgf pinfo chart items) ty@(DTyp _ start _) =
nubsort [e1 | e <- exps, Right e1 <- [checkExpr pgf e ty]]
where
(mb_agenda,acc) = TMap.decompose items
agenda = maybe [] Set.toList mb_agenda
(_,st) = process Nothing (\_ _ -> id) (sequences pinfo) (functions pinfo) agenda () chart
exps = nubsort $ do
exps = do
cat <- fromMaybe [] (Map.lookup start (startCats pinfo))
(funid,args) <- foldForest (\funid args -> (:) (funid,args)) (\_ _ args -> args)
[] cat (productions pinfo)
@@ -102,7 +117,7 @@ extractExps (State pinfo chart items) (DTyp _ start _) = exps
return tree
go rec fcat' (d,fcat)
| fcat < totalCats pinfo = return (Set.empty,Meta (fcat'*10+d)) -- FIXME: here we assume that every rule has at most 10 arguments
| fcat < totalCats pinfo = 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 ->
do let FFun fn _ lins = functions pinfo ! funid
@@ -118,14 +133,14 @@ extractExps (State pinfo chart items) (DTyp _ start _) = exps
check_ho_fun fun args
| fun == _V = return (head args)
| fun == _B = return (foldl1 Set.difference (map fst args),Abs [mkVar (snd e) | e <- tail args] (snd (head args)))
| otherwise = return (Set.unions (map fst args),Fun fun (map snd args))
| fun == _B = return (foldl1 Set.difference (map fst args), foldr (\x e -> EAbs (mkVar (snd x)) e) (snd (head args)) (tail args))
| otherwise = return (Set.unions (map fst args),foldl (\e x -> EApp e (snd x)) (EFun fun) args)
mkVar (Var v) = v
mkVar (Meta _) = wildCId
mkVar (EFun v) = v
mkVar (EMeta _) = wildCId
freeVar (Var v) = Set.singleton v
freeVar _ = Set.empty
freeVar (EFun v) = Set.singleton v
freeVar _ = Set.empty
_B = mkCId "_B"
_V = mkCId "_V"
@@ -194,12 +209,12 @@ 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)
| fcat == fcatString = Just ([t],Lit (LStr t))
| fcat == fcatInt = case reads t of {[(n,"")] -> Just ([t],Lit (LInt n));
| fcat == fcatString = Just ([t],ELit (LStr t))
| fcat == fcatInt = case reads t of {[(n,"")] -> Just ([t],ELit (LInt n));
_ -> Nothing }
| fcat == fcatFloat = case reads t of {[(d,"")] -> Just ([t],Lit (LFlt d));
| fcat == fcatFloat = case reads t of {[(d,"")] -> Just ([t],ELit (LFlt d));
_ -> Nothing }
| fcat == fcatVar = Just ([t],Var (mkCId t))
| fcat == fcatVar = Just ([t],EFun (mkCId t))
litCatMatch _ _ = Nothing
@@ -263,7 +278,7 @@ insertPC key fcat chart = Map.insert key fcat chart
-- Forest
----------------------------------------------------------------
foldForest :: (FunId -> [FCat] -> b -> b) -> (Tree -> [String] -> b -> b) -> b -> FCat -> IntMap.IntMap (Set.Set Production) -> b
foldForest :: (FunId -> [FCat] -> b -> b) -> (Expr -> [String] -> b -> b) -> b -> FCat -> IntMap.IntMap (Set.Set Production) -> b
foldForest f g b fcat forest =
case IntMap.lookup fcat forest of
Nothing -> b
@@ -280,7 +295,7 @@ foldForest f g b fcat forest =
-- | An abstract data type whose values represent
-- the current state in an incremental parser.
data ParseState = State ParserInfo Chart (TMap.TrieMap String (Set.Set Active))
data ParseState = State PGF ParserInfo Chart (TMap.TrieMap String (Set.Set Active))
data Chart
= Chart

1
src/PGF/Parsing/FCFG/Utilities.hs
View File

@@ -20,6 +20,7 @@ import Data.List (groupBy)
import PGF.CId
import PGF.Data
import PGF.Tree
import GF.Data.Assoc
import GF.Data.Utilities (sameLength, foldMerge, splitBy)