msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

literal categories in the incremental parser

Browse Source
This commit is contained in:
krasimir
2008-10-14 15:29:50 +00:00
parent e4dc63f665
commit 57ee52103d
3 changed files with 68 additions and 24 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
src/GF/Compile/GeneratePMCFG.hs
View File

@@ -262,10 +262,18 @@ type FunSet = Map.Map FFun FunId
type CoerceSet= Map.Map [FCat] FCat type CoerceSet= Map.Map [FCat] FCat
emptyFRulesEnv cnc_defs lincats = emptyFRulesEnv cnc_defs lincats =
let (last_id,catSet) = Map.mapAccum computeCatRange 0 lincats let (last_id,catSet) = Map.mapAccumWithKey computeCatRange 0 lincats
in GrammarEnv last_id catSet Map.empty Map.empty Map.empty IntMap.empty in GrammarEnv last_id catSet Map.empty Map.empty Map.empty IntMap.empty
where where
computeCatRange index ctype = (index+size,(index,index+size-1,poly)) cidString = mkCId "String"
cidInt = mkCId "Int"
cidFloat = mkCId "Float"
computeCatRange index cat ctype
| cat == cidString = (index, (fcatString,fcatString,[]))
| cat == cidInt = (index, (fcatInt, fcatInt, []))
| cat == cidFloat = (index, (fcatFloat, fcatFloat, []))
| otherwise = (index+size,(index,index+size-1,poly))
where where
(size,poly) = getMultipliers 1 [] ctype (size,poly) = getMultipliers 1 [] ctype

1
src/PGF/Data.hs
View File

@@ -122,6 +122,7 @@ type Profile = [Int]
data Production data Production
= FApply {-# UNPACK #-} !FunId [FCat] = FApply {-# UNPACK #-} !FunId [FCat]
| FCoerce {-# UNPACK #-} !FCat | FCoerce {-# UNPACK #-} !FCat
| FLit Literal String
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show)
data FFun = FFun CId [Profile] {-# UNPACK #-} !(UArray FIndex SeqId) deriving (Eq,Ord,Show) data FFun = FFun CId [Profile] {-# UNPACK #-} !(UArray FIndex SeqId) deriving (Eq,Ord,Show)
type FSeq = Array FPointPos FSymbol type FSeq = Array FPointPos FSymbol

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

@@ -29,7 +29,8 @@ initState :: ParserInfo -> CId -> ParseState
initState pinfo start = initState pinfo start =
let items = do let items = do
cat <- fromMaybe [] (Map.lookup start (startCats pinfo)) cat <- fromMaybe [] (Map.lookup start (startCats pinfo))
(funid,args) <- foldForest (\funid args -> (:) (funid,args)) [] cat (productions pinfo) (funid,args) <- foldForest (\funid args -> (:) (funid,args)) (\_ _ args -> args)
[] cat (productions pinfo)
let FFun fn _ lins = functions pinfo ! funid let FFun fn _ lins = functions pinfo ! funid
(lbl,seqid) <- assocs lins (lbl,seqid) <- assocs lins
return (Active 0 0 funid seqid args (AK cat lbl)) return (Active 0 0 funid seqid args (AK cat lbl))
@@ -48,19 +49,39 @@ initState pinfo start =
nextState :: ParseState -> String -> Maybe ParseState nextState :: ParseState -> String -> Maybe ParseState
nextState (State pinfo chart items) t = nextState (State pinfo chart items) t =
let (items1,chart1) = process add (sequences pinfo) (functions pinfo) (Set.toList items) Set.empty chart let (items1,chart1) = process add (sequences pinfo) (functions pinfo) (Set.toList items) Set.empty chart
chart2 = chart1{ active =emptyAC (items2,chart2) = addLiteral pinfo (AK fcatString 0) (LStr t) t items1 chart1
, actives=active chart1 : actives chart1 (items3,chart3) = case reads t of {[(n,"")] -> addLiteral pinfo (AK fcatInt 0) (LInt n) t items2 chart2;
_ -> (items2,chart2)}
(items4,chart4) = case reads t of {[(d,"")] -> addLiteral pinfo (AK fcatFloat 0) (LFlt d) t items3 chart3;
_ -> (items3,chart3)}
chart5 = chart4{ active =emptyAC
, actives=active chart4 : actives chart4
, passive=emptyPC , passive=emptyPC
, offset =offset chart1+1 , offset =offset chart4+1
} }
in if Set.null items1 in if Set.null items4
then Nothing then Nothing
else Just (State pinfo chart2 items1) else Just (State pinfo chart5 items4)
where where
add (KS tok) item set add (KS tok) item set
| tok == t = Set.insert item set | tok == t = Set.insert item set
| otherwise = set | otherwise = set
addLiteral :: ParserInfo -> ActiveKey -> Literal -> String -> Set.Set Active -> Chart -> (Set.Set Active,Chart)
addLiteral pinfo key lit s items chart =
case lookupAC key (active chart) of
Nothing -> (items,chart)
Just set -> let fid = nextId chart
items1 = Set.fold (\(Active j ppos funid seqid args key) ->
let FSymCat d _ = unsafeAt (unsafeAt (sequences pinfo) seqid) ppos
in Set.insert (Active j (ppos+1) funid seqid (updateAt d fid args) key)) items set
chart1 = chart{forest =IntMap.insert fid (Set.singleton (FLit lit s)) (forest chart)
,nextId =nextId chart+1
}
in (items1,chart1)
-- | If the next token is not known but only its prefix (possible empty prefix) -- | 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 -- then the 'getCompletions' function can be used to calculate the possible
-- next words and the consequent states. This is used for word completions in -- next words and the consequent states. This is used for word completions in
@@ -86,7 +107,8 @@ extractExps (State pinfo chart items) start = exps
exps = nubsort $ do exps = nubsort $ do
cat <- fromMaybe [] (Map.lookup start (startCats pinfo)) cat <- fromMaybe [] (Map.lookup start (startCats pinfo))
(funid,args) <- foldForest (\funid args -> (:) (funid,args)) [] cat (productions pinfo) (funid,args) <- foldForest (\funid args -> (:) (funid,args)) (\_ _ args -> args)
[] cat (productions pinfo)
let FFun fn _ lins = functions pinfo ! funid let FFun fn _ lins = functions pinfo ! funid
lbl <- indices lins lbl <- indices lins
Just fid <- [lookupPC (PK cat lbl 0) (passive st)] Just fid <- [lookupPC (PK cat lbl 0) (passive st)]
@@ -94,10 +116,15 @@ extractExps (State pinfo chart items) start = exps
go rec fcat go rec fcat
| Set.member fcat rec = mzero | Set.member fcat rec = mzero
| otherwise = do (funid,args) <- foldForest (\funid args -> (:) (funid,args)) [] fcat (forest st) | otherwise = foldForest (\funid args trees ->
let FFun fn _ lins = functions pinfo ! funid do let FFun fn _ lins = functions pinfo ! funid
args <- mapM (go (Set.insert fcat rec)) args args <- mapM (go (Set.insert fcat rec)) args
return (Fun fn args) return (Fun fn args)
`mplus`
trees)
(\lit _ trees -> Lit lit : trees)
[] fcat (forest st)
process fn !seqs !funs [] acc chart = (acc,chart) process fn !seqs !funs [] acc chart = (acc,chart)
process fn !seqs !funs (item@(Active j ppos funid seqid args key0):items) acc chart process fn !seqs !funs (item@(Active j ppos funid seqid args key0):items) acc chart
@@ -109,11 +136,13 @@ process fn !seqs !funs (item@(Active j ppos funid seqid args key0):items) acc ch
items2 = case lookupPC (mkPK key k) (passive chart) of items2 = case lookupPC (mkPK key k) (passive chart) of
Nothing -> items Nothing -> items
Just id -> (Active j (ppos+1) funid seqid (updateAt d id args) key0) : items Just id -> (Active j (ppos+1) funid seqid (updateAt d id args) key0) : items
items3 = foldForest (\funid args -> (:) (Active k 0 funid (rhs funid r) args key)) items2 fid (forest chart) (acc2,items3) = foldForest (\funid args (lits,items) -> (lits,(Active k 0 funid (rhs funid r) args key) : items))
(\lit s (acc,items) -> (fn (KS s) (Active j (ppos+1) funid seqid args key0) acc,items))
(acc,items2) fid (forest chart)
in case lookupAC key (active chart) of in case lookupAC key (active chart) of
Nothing -> process fn seqs funs items3 acc chart{active=insertAC key (Set.singleton item) (active chart)} Nothing -> process fn seqs funs items3 acc2 chart{active=insertAC key (Set.singleton item) (active chart)}
Just set | Set.member item set -> process fn seqs funs items acc chart Just set | Set.member item set -> process fn seqs funs items acc chart
| otherwise -> process fn seqs funs items2 acc chart{active=insertAC key (Set.insert item set) (active chart)} | otherwise -> process fn seqs funs items2 acc2 chart{active=insertAC key (Set.insert item set) (active chart)}
FSymTok tok -> let !acc' = fn tok (Active j (ppos+1) funid seqid args key0) acc FSymTok tok -> let !acc' = fn tok (Active j (ppos+1) funid seqid args key0) acc
in process fn seqs funs items acc' chart in process fn seqs funs items acc' chart
| otherwise = | otherwise =
@@ -140,9 +169,14 @@ process fn !seqs !funs (item@(Active j ppos funid seqid args key0):items) acc ch
rhs funid lbl = unsafeAt lins lbl rhs funid lbl = unsafeAt lins lbl
where where
FFun _ _ lins = unsafeAt funs funid FFun _ _ lins = unsafeAt funs funid
lit2tok (LStr t) = KS t
lit2tok (LInt n) = KS (show n)
lit2tok (LFlt d) = KS (show d)
updateAt :: Int -> a -> [a] -> [a] updateAt :: Int -> a -> [a] -> [a]
updateAt nr x xs = [if i == nr then x else y | (i,y) <- zip [0..] xs] updateAt nr x xs = [if i == nr then x else y | (i,y) <- zip [0..] xs]
---------------------------------------------------------------- ----------------------------------------------------------------
@@ -205,14 +239,15 @@ insertPC key fcat chart = Map.insert key fcat chart
-- Forest -- Forest
---------------------------------------------------------------- ----------------------------------------------------------------
foldForest :: (FunId -> [FCat] -> b -> b) -> b -> FCat -> IntMap.IntMap (Set.Set Production) -> b foldForest :: (FunId -> [FCat] -> b -> b) -> (Literal -> String -> b -> b) -> b -> FCat -> IntMap.IntMap (Set.Set Production) -> b
foldForest f b fcat forest = foldForest f g b fcat forest =
case IntMap.lookup fcat forest of case IntMap.lookup fcat forest of
Nothing -> b Nothing -> b
Just set -> Set.fold foldPassive b set Just set -> Set.fold foldProd b set
where where
foldPassive (FCoerce fcat) b = foldForest f b fcat forest foldProd (FCoerce fcat) b = foldForest f g b fcat forest
foldPassive (FApply funid args) b = f funid args b foldProd (FApply funid args) b = f funid args b
foldProd (FLit lit s) b = g lit s b
---------------------------------------------------------------- ----------------------------------------------------------------