summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/GF/Compile/GeneratePMCFG.hs12
-rw-r--r--src/PGF/Data.hs1
-rw-r--r--src/PGF/Parsing/FCFG/Incremental.hs79
3 files changed, 68 insertions, 24 deletions
diff --git a/src/GF/Compile/GeneratePMCFG.hs b/src/GF/Compile/GeneratePMCFG.hs
index c3e6e8cb4..870396255 100644
--- a/src/GF/Compile/GeneratePMCFG.hs
+++ b/src/GF/Compile/GeneratePMCFG.hs
@@ -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
diff --git a/src/PGF/Data.hs b/src/PGF/Data.hs
index 8fe7882de..224059ed6 100644
--- a/src/PGF/Data.hs
+++ b/src/PGF/Data.hs
@@ -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
diff --git a/src/PGF/Parsing/FCFG/Incremental.hs b/src/PGF/Parsing/FCFG/Incremental.hs
index 6550902a1..c8d9d8f8d 100644
--- a/src/PGF/Parsing/FCFG/Incremental.hs
+++ b/src/PGF/Parsing/FCFG/Incremental.hs
@@ -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
----------------------------------------------------------------
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 21:04:02 +0000