forked from GitHub/gf-core
threat category _Var as a literal category
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
||||
Reference in New Issue
Block a user