mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-16 08:19:31 -06:00
rename isLiteralFCat -> isPredefFId, fcat(String|Int|Float) -> fid(String|Int|Float)
This commit is contained in:
@@ -450,9 +450,9 @@ emptyGrammarEnv gr (m,mo) =
|
||||
in GrammarEnv last_id (IntMap.singleton 0 catSet) Map.empty Map.empty Map.empty IntMap.empty
|
||||
where
|
||||
computeCatRange index cat ctype
|
||||
| cat == cString = (index,(fcatString,fcatString,PFCat 0 cat (CRec [(theLinLabel,Identity (CStr 0))])))
|
||||
| cat == cInt = (index,(fcatInt, fcatInt, PFCat 0 cat (CRec [(theLinLabel,Identity (CStr 0))])))
|
||||
| cat == cFloat = (index,(fcatFloat, fcatFloat, PFCat 0 cat (CRec [(theLinLabel,Identity (CStr 0))])))
|
||||
| cat == cString = (index,(fidString,fidString,PFCat 0 cat (CRec [(theLinLabel,Identity (CStr 0))])))
|
||||
| cat == cInt = (index,(fidInt, fidInt, PFCat 0 cat (CRec [(theLinLabel,Identity (CStr 0))])))
|
||||
| cat == cFloat = (index,(fidFloat, fidFloat, PFCat 0 cat (CRec [(theLinLabel,Identity (CStr 0))])))
|
||||
| otherwise = (index+size,(index,index+size-1,PFCat 0 cat schema))
|
||||
where
|
||||
((_,size),schema) = compute (0,1) ctype
|
||||
|
||||
@@ -70,7 +70,7 @@ pgfToCFG pgf lang = mkCFG (showCId (lookStartCat pgf)) extCats (startRules ++ co
|
||||
startRules :: [CFRule]
|
||||
startRules = [CFRule (showCId c) [NonTerminal (fcatToCat fc r)] (CFRes 0)
|
||||
| (c,CncCat s e lbls) <- Map.toList (cnccats cnc),
|
||||
fc <- range (s,e), not (isLiteralFCat fc),
|
||||
fc <- range (s,e), not (isPredefFId fc),
|
||||
r <- [0..catLinArity fc-1]]
|
||||
|
||||
ruleToCFRule :: (FId,Production) -> [CFRule]
|
||||
@@ -86,7 +86,7 @@ pgfToCFG pgf lang = mkCFG (showCId (lookStartCat pgf)) extCats (startRules ++ co
|
||||
mkRhs = concatMap symbolToCFSymbol . Array.elems
|
||||
|
||||
containsLiterals :: Array DotPos Symbol -> Bool
|
||||
containsLiterals row = any isLiteralFCat [args!!n | SymCat n _ <- Array.elems row] ||
|
||||
containsLiterals row = any isPredefFId [args!!n | SymCat n _ <- Array.elems row] ||
|
||||
not (null [n | SymLit n _ <- Array.elems row]) -- only this is needed for PMCFG.
|
||||
-- The first line is for backward compat.
|
||||
|
||||
|
||||
@@ -103,11 +103,11 @@ readLanguage = readCId
|
||||
showLanguage :: Language -> String
|
||||
showLanguage = showCId
|
||||
|
||||
fcatString, fcatInt, fcatFloat, fcatVar :: Int
|
||||
fcatString = (-1)
|
||||
fcatInt = (-2)
|
||||
fcatFloat = (-3)
|
||||
fcatVar = (-4)
|
||||
fidString, fidInt, fidFloat, fidVar :: FId
|
||||
fidString = (-1)
|
||||
fidInt = (-2)
|
||||
fidFloat = (-3)
|
||||
fidVar = (-4)
|
||||
|
||||
isLiteralFCat :: FId -> Bool
|
||||
isLiteralFCat = (`elem` [fcatString, fcatInt, fcatFloat, fcatVar])
|
||||
isPredefFId :: FId -> Bool
|
||||
isPredefFId = (`elem` [fidString, fidInt, fidFloat, fidVar])
|
||||
|
||||
@@ -173,8 +173,8 @@ filterProductions prods0 prods
|
||||
where
|
||||
set1 = Set.filter (filterRule prods0) set
|
||||
|
||||
filterRule prods0 (PApply funid args) = all (\fcat -> isLiteralFCat fcat || IntMap.member fcat prods0) args
|
||||
filterRule prods0 (PCoerce fcat) = isLiteralFCat fcat || IntMap.member fcat prods0
|
||||
filterRule prods0 (PApply funid args) = all (\fid -> isPredefFId fid || IntMap.member fid prods0) args
|
||||
filterRule prods0 (PCoerce fid) = isPredefFId fid || IntMap.member fid prods0
|
||||
filterRule prods0 _ = True
|
||||
|
||||
updateConcrete abs cnc =
|
||||
@@ -191,8 +191,8 @@ updateConcrete abs cnc =
|
||||
then Nothing
|
||||
else Just prods'
|
||||
|
||||
is_ho_prod (PApply _ [fid]) | fid == fcatVar = True
|
||||
is_ho_prod _ = False
|
||||
is_ho_prod (PApply _ [fid]) | fid == fidVar = True
|
||||
is_ho_prod _ = False
|
||||
|
||||
ho_fids :: IntSet.IntSet
|
||||
ho_fids = IntSet.fromList [fid | cat <- ho_cats
|
||||
|
||||
@@ -138,10 +138,10 @@ feedLiteral (PState pgf cnc chart items) (ELit lit) =
|
||||
|
||||
magic lit fid =
|
||||
case lit of
|
||||
LStr s | fid == fcatString -> Just (cidString, ELit lit, words s)
|
||||
LInt n | fid == fcatInt -> Just (cidInt, ELit lit, [show n])
|
||||
LFlt d | fid == fcatFloat -> Just (cidFloat, ELit lit, [show d])
|
||||
_ -> Nothing
|
||||
LStr s | fid == fidString -> Just (cidString, ELit lit, words s)
|
||||
LInt n | fid == fidInt -> Just (cidInt, ELit lit, [show n])
|
||||
LFlt d | fid == fidFloat -> Just (cidFloat, ELit lit, [show d])
|
||||
_ -> Nothing
|
||||
|
||||
-- | 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
|
||||
@@ -344,14 +344,14 @@ process mbt fn !seqs !funs (item@(Active j ppos funid seqid args key0):items) ac
|
||||
updateAt :: Int -> a -> [a] -> [a]
|
||||
updateAt nr x xs = [if i == nr then x else y | (i,y) <- zip [0..] xs]
|
||||
|
||||
litCatMatch (Just t) fcat
|
||||
| fcat == fcatString = Just (cidString,ELit (LStr t),[t])
|
||||
| fcat == fcatInt = case reads t of {[(n,"")] -> Just (cidInt,ELit (LInt n),[t]);
|
||||
_ -> Nothing }
|
||||
| fcat == fcatFloat = case reads t of {[(d,"")] -> Just (cidFloat,ELit (LFlt d),[t]);
|
||||
_ -> Nothing }
|
||||
| fcat == fcatVar = Just (cidVar,EFun (mkCId t),[t])
|
||||
litCatMatch _ _ = Nothing
|
||||
litCatMatch (Just t) fid
|
||||
| fid == fidString = Just (cidString,ELit (LStr t),[t])
|
||||
| fid == fidInt = case reads t of {[(n,"")] -> Just (cidInt,ELit (LInt n),[t]);
|
||||
_ -> Nothing }
|
||||
| fid == fidFloat = case reads t of {[(d,"")] -> Just (cidFloat,ELit (LFlt d),[t]);
|
||||
_ -> Nothing }
|
||||
| fid == fidVar = Just (cidVar,EFun (mkCId t),[t])
|
||||
litCatMatch _ _ = Nothing
|
||||
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
||||
@@ -56,12 +56,12 @@ ppCnc name cnc =
|
||||
nest 2 (vcat (map ppPrintName (Map.toList (printnames cnc))))) $$
|
||||
char '}'
|
||||
|
||||
ppProduction (fcat,PApply funid args) =
|
||||
ppFCat fcat <+> text "->" <+> ppFunId funid <> brackets (hcat (punctuate comma (map ppFCat args)))
|
||||
ppProduction (fcat,PCoerce arg) =
|
||||
ppFCat fcat <+> text "->" <+> char '_' <> brackets (ppFCat arg)
|
||||
ppProduction (fcat,PConst _ _ ss) =
|
||||
ppFCat fcat <+> text "->" <+> ppStrs ss
|
||||
ppProduction (fid,PApply funid args) =
|
||||
ppFId fid <+> text "->" <+> ppFunId funid <> brackets (hcat (punctuate comma (map ppFId args)))
|
||||
ppProduction (fid,PCoerce arg) =
|
||||
ppFId fid <+> text "->" <+> char '_' <> brackets (ppFId arg)
|
||||
ppProduction (fid,PConst _ _ ss) =
|
||||
ppFId fid <+> text "->" <+> ppStrs ss
|
||||
|
||||
ppCncFun (funid,CncFun fun arr) =
|
||||
ppFunId funid <+> text ":=" <+> parens (hcat (punctuate comma (map ppSeqId (elems arr)))) <+> brackets (ppCId fun)
|
||||
@@ -70,7 +70,7 @@ ppSeq (seqid,seq) =
|
||||
ppSeqId seqid <+> text ":=" <+> hsep (map ppSymbol (elems seq))
|
||||
|
||||
ppCncCat (id,(CncCat start end labels)) =
|
||||
ppCId id <+> text ":=" <+> (text "range " <+> brackets (ppFCat start <+> text ".." <+> ppFCat end) $$
|
||||
ppCId id <+> text ":=" <+> (text "range " <+> brackets (ppFId start <+> text ".." <+> ppFId end) $$
|
||||
text "labels" <+> brackets (vcat (map (text . show) (elems labels))))
|
||||
|
||||
ppPrintName (id,name) =
|
||||
@@ -85,12 +85,12 @@ ppAlt (Alt ts ps) = ppStrs ts <+> char '/' <+> hsep (map (doubleQuotes . text) p
|
||||
|
||||
ppStrs ss = doubleQuotes (hsep (map text ss))
|
||||
|
||||
ppFCat fcat
|
||||
| fcat == fcatString = text "CString"
|
||||
| fcat == fcatInt = text "CInt"
|
||||
| fcat == fcatFloat = text "CFloat"
|
||||
| fcat == fcatVar = text "CVar"
|
||||
| otherwise = char 'C' <> int fcat
|
||||
ppFId fid
|
||||
| fid == fidString = text "CString"
|
||||
| fid == fidInt = text "CInt"
|
||||
| fid == fidFloat = text "CFloat"
|
||||
| fid == fidVar = text "CVar"
|
||||
| otherwise = char 'C' <> int fid
|
||||
|
||||
ppFunId funid = char 'F' <> int funid
|
||||
ppSeqId seqid = char 'S' <> int seqid
|
||||
|
||||
Reference in New Issue
Block a user