GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-09 04:59:31 -06:00
Code Issues Packages Projects Releases Wiki 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
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
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
(size,poly) = getMultipliers 1 [] ctype

1
src/PGF/Data.hs
View File

@@ -122,6 +122,7 @@ type Profile = [Int]
data Production
= FApply {-# UNPACK #-} !FunId [FCat]
| FCoerce {-# UNPACK #-} !FCat
| FLit Literal String
deriving (Eq,Ord,Show)
data FFun = FFun CId [Profile] {-# UNPACK #-} !(UArray FIndex SeqId) deriving (Eq,Ord,Show)
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 =
let items = do
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
(lbl,seqid) <- assocs lins
return (Active 0 0 funid seqid args (AK cat lbl))
@@ -48,19 +49,39 @@ initState pinfo start =
nextState :: ParseState -> String -> Maybe ParseState
nextState (State pinfo chart items) t =
let (items1,chart1) = process add (sequences pinfo) (functions pinfo) (Set.toList items) Set.empty chart
chart2 = chart1{ active =emptyAC
, actives=active chart1 : actives chart1
(items2,chart2) = addLiteral pinfo (AK fcatString 0) (LStr t) t items1 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
, offset =offset chart1+1
, offset =offset chart4+1
}
in if Set.null items1
in if Set.null items4
then Nothing
else Just (State pinfo chart2 items1)
else Just (State pinfo chart5 items4)
where
add (KS tok) item set
| tok == t = Set.insert item 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)
-- then the 'getCompletions' function can be used to calculate the possible
-- 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
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
lbl <- indices lins
Just fid <- [lookupPC (PK cat lbl 0) (passive st)]
@@ -94,10 +116,15 @@ extractExps (State pinfo chart items) start = exps
go rec fcat
| Set.member fcat rec = mzero
| otherwise = do (funid,args) <- foldForest (\funid args -> (:) (funid,args)) [] fcat (forest st)
let FFun fn _ lins = functions pinfo ! funid
args <- mapM (go (Set.insert fcat rec)) args
return (Fun fn args)
| otherwise = foldForest (\funid args trees ->
do let FFun fn _ lins = functions pinfo ! funid
args <- mapM (go (Set.insert fcat rec)) 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 (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
Nothing -> 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
Nothing -> process fn seqs funs items3 acc chart{active=insertAC key (Set.singleton item) (active 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)}
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
| 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
in process fn seqs funs items acc' chart
| 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
where
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 nr x xs = [if i == nr then x else y | (i,y) <- zip [0..] xs]
updateAt :: Int -> a -> [a] -> [a]
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
----------------------------------------------------------------
foldForest :: (FunId -> [FCat] -> b -> b) -> b -> FCat -> IntMap.IntMap (Set.Set Production) -> b
foldForest f b fcat forest =
foldForest :: (FunId -> [FCat] -> b -> b) -> (Literal -> 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
Just set -> Set.fold foldPassive b set
Just set -> Set.fold foldProd b set
where
foldPassive (FCoerce fcat) b = foldForest f b fcat forest
foldPassive (FApply funid args) b = f funid args b
foldProd (FCoerce fcat) b = foldForest f g b fcat forest
foldProd (FApply funid args) b = f funid args b
foldProd (FLit lit s) b = g lit s b
----------------------------------------------------------------