1
0
forked from GitHub/gf-core

threat category _Var as a literal category

This commit is contained in:
krasimir
2008-10-15 08:38:34 +00:00
parent b01fcc8c3c
commit 8386c8b939
3 changed files with 18 additions and 15 deletions

View File

@@ -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

View File

@@ -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

View File

@@ -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
----------------------------------------------------------------