diff --git a/src/GF/Compile/GeneratePMCFG.hs b/src/GF/Compile/GeneratePMCFG.hs index 20ba80e2e..e05ef5afa 100644 --- a/src/GF/Compile/GeneratePMCFG.hs +++ b/src/GF/Compile/GeneratePMCFG.hs @@ -268,11 +268,13 @@ emptyFRulesEnv cnc_defs lincats = cidString = mkCId "String" cidInt = mkCId "Int" cidFloat = mkCId "Float" + cidVar = mkCId "_Var" computeCatRange index cat ctype | cat == cidString = (index, (fcatString,fcatString,[])) | cat == cidInt = (index, (fcatInt, fcatInt, [])) | cat == cidFloat = (index, (fcatFloat, fcatFloat, [])) + | cat == cidVar = (index, (fcatVar, fcatVar, [])) | 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 f50a49c31..644e33750 100644 --- a/src/PGF/Data.hs +++ b/src/PGF/Data.hs @@ -122,7 +122,7 @@ type Profile = [Int] data Production = FApply {-# UNPACK #-} !FunId [FCat] | FCoerce {-# UNPACK #-} !FCat - | FLit Literal String + | FConst Tree 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 12063f2a9..2ab04acf2 100644 --- a/src/PGF/Parsing/FCFG/Incremental.hs +++ b/src/PGF/Parsing/FCFG/Incremental.hs @@ -45,26 +45,27 @@ 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 - (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) = addConst pinfo (AK fcatString 0) (Lit (LStr t)) t items1 chart1 + (items3,chart3) = case reads t of {[(n,"")] -> addConst pinfo (AK fcatInt 0) (Lit (LInt n)) t items2 chart2; _ -> (items2,chart2)} - (items4,chart4) = case reads t of {[(d,"")] -> addLiteral pinfo (AK fcatFloat 0) (LFlt d) t items3 chart3; + (items4,chart4) = case reads t of {[(d,"")] -> addConst pinfo (AK fcatFloat 0) (Lit (LFlt d)) t items3 chart3; _ -> (items3,chart3)} - chart5 = chart4{ active =emptyAC - , actives=active chart4 : actives chart4 + (items5,chart5) = addConst pinfo (AK fcatVar 0) (Var (mkCId t)) t items4 chart4 + chart6 = chart5{ active =emptyAC + , actives=active chart5 : actives chart5 , passive=emptyPC - , offset =offset chart4+1 + , offset =offset chart5+1 } - in if Set.null items4 + in if Set.null items5 then Nothing - else Just (State pinfo chart5 items4) + else Just (State pinfo chart6 items5) 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 = +addConst :: ParserInfo -> ActiveKey -> Tree -> String -> Set.Set Active -> Chart -> (Set.Set Active,Chart) +addConst pinfo key const s items chart = case lookupAC key (active chart) of Nothing -> (items,chart) Just set -> let fid = nextId chart @@ -73,7 +74,7 @@ addLiteral pinfo key lit s items chart = 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) + chart1 = chart{forest =IntMap.insert fid (Set.singleton (FConst const s)) (forest chart) ,nextId =nextId chart+1 } in (items1,chart1) @@ -119,7 +120,7 @@ extractExps (State pinfo chart items) start = exps return (Fun fn args) `mplus` trees) - (\lit _ trees -> Lit lit : trees) + (\const _ trees -> const : trees) [] fcat (forest st) @@ -236,7 +237,7 @@ insertPC key fcat chart = Map.insert key fcat chart -- Forest ---------------------------------------------------------------- -foldForest :: (FunId -> [FCat] -> b -> b) -> (Literal -> String -> b -> b) -> b -> FCat -> IntMap.IntMap (Set.Set Production) -> b +foldForest :: (FunId -> [FCat] -> b -> b) -> (Tree -> 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 @@ -244,7 +245,7 @@ foldForest f g b fcat forest = where 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 + foldProd (FConst const s) b = g const s b ----------------------------------------------------------------