forked from GitHub/gf-core
some var parser bug fixes
This commit is contained in:
@@ -73,7 +73,7 @@ mkCfRules m fun cat args (lab, itss) = mapM mkOneRule itss
|
||||
mkOne (A c i) = mkOne (AB c 0 i)
|
||||
mkOne (AB _ b i) = (map mkB [0..b-1], [k | (k,(j,_,True)) <- nonterms, j==i])
|
||||
where
|
||||
mkB j = [p | (p,(k, LV l,False)) <- nonterms, k == i, l == j]
|
||||
mkB x = [k | (k,(j, LV y,False)) <- nonterms, j == i, y == x]
|
||||
|
||||
-- intermediate data structure of CFItems with information for profiles
|
||||
data PreCFItem =
|
||||
@@ -143,10 +143,10 @@ term2CFItems m t = errIn "forming cf items" $ case t of
|
||||
tryMkCFTerm itss = return itss
|
||||
|
||||
extrR arg lab = case (arg,lab) of
|
||||
(Arg (A cat pos), l@(L _)) -> return [[PNonterm (cIQ cat) pos l True]]
|
||||
(Arg (A cat pos), l@(LV _)) -> return [[PNonterm (cIQ cat) pos l False]]
|
||||
(Arg (AB cat pos b), l@(L _)) -> return [[PNonterm (cIQ cat) pos l True]]
|
||||
(Arg (AB cat pos b), l@(LV _)) -> return [[PNonterm (cIQ cat) pos l False]]
|
||||
(Arg (A cat pos), l@(L _)) -> return [[PNonterm (cIQ cat) pos l True]]
|
||||
(Arg (A cat pos), l@(LV _)) -> return [[PNonterm (cIQ cat) pos l False]]
|
||||
(Arg (AB cat b pos), l@(L _)) -> return [[PNonterm (cIQ cat) pos l True]]
|
||||
(Arg (AB cat b pos), l@(LV _)) -> return [[PNonterm (cIQ cat) pos l False]]
|
||||
---- ??
|
||||
_ -> prtBad "cannot extract record field from" arg
|
||||
cIQ c = if isPredefCat c then CIQ cPredefAbs c else CIQ m c
|
||||
@@ -158,7 +158,7 @@ mkCFPredef opts rules = (ruls, \s -> preds0 s ++ look s) where
|
||||
else (rules,emptyTrie)
|
||||
preds0 s =
|
||||
[(cat, metaCFFun) | TM _ _ <- [s], cat <- cats] ++
|
||||
[(cat, varCFFun x) | TV x <- [s], cat <- cats] ++
|
||||
[(cat, varCFFun x) | TV x <- [s], cat <- catVarCF : cats] ++
|
||||
[(cfCatString, stringCFFun t) | TL t <- [s]] ++
|
||||
[(cfCatInt, intCFFun t) | TI t <- [s]]
|
||||
cats = map fst rules
|
||||
|
||||
@@ -209,9 +209,10 @@ execC co@(comm, opts0) sa@((st,(h,_)),a) = checkOptions st co >> case comm of
|
||||
---- deprec! CSetLocalFlag lang -> changeState (addLocalOptions lang opts0) sa
|
||||
|
||||
CHelp (Just c) -> returnArg (AString (txtHelpCommand c)) sa
|
||||
CHelp _
|
||||
| oElem showAll opts -> returnArg (AString txtHelpFile) sa
|
||||
| otherwise -> returnArg (AString txtHelpFileSummary) sa
|
||||
CHelp _ -> case opts0 of
|
||||
Opts [o] | o == showAll -> returnArg (AString txtHelpFile) sa
|
||||
Opts [o] -> returnArg (AString (txtHelpCommand ('-':prOpt o))) sa
|
||||
_ -> returnArg (AString txtHelpFileSummary) sa
|
||||
|
||||
CPrintGrammar -> returnArg (AString (optPrintGrammar opts gro)) sa
|
||||
CPrintGlobalOptions -> justOutput (putStrLn $ prShellStateInfo st) sa
|
||||
|
||||
@@ -164,7 +164,7 @@ optionsOfCommand co = case co of
|
||||
CPrintGrammar -> both "utf8" "printer lang"
|
||||
CPrintMultiGrammar -> both "utf8" "printer"
|
||||
|
||||
CHelp _ -> opts "all"
|
||||
CHelp _ -> opts "all filter length lexer unlexer printer transform depth number"
|
||||
|
||||
CImpure ICEditSession -> opts "f"
|
||||
CImpure ICTranslateSession -> both "f langs" "cat"
|
||||
|
||||
@@ -320,6 +320,7 @@ customTokenizer =
|
||||
,(strCI "vars", const $ tokVars)
|
||||
,(strCI "chars", const $ map (tS . singleton))
|
||||
,(strCI "code", const $ lexHaskell)
|
||||
,(strCI "codevars", const $ (mkTokVars lexHaskell))
|
||||
,(strCI "text", const $ lexText)
|
||||
,(strCI "unglue", \gr -> map tS . decomposeWords (stateMorpho gr))
|
||||
,(strCI "codelit", lexHaskellLiteral . stateIsWord)
|
||||
|
||||
@@ -20,6 +20,7 @@ import Option
|
||||
import Custom
|
||||
import ShellState
|
||||
|
||||
import PPrCF (prCFTree)
|
||||
import qualified ParseGFC as N
|
||||
|
||||
import Operations
|
||||
@@ -69,7 +70,10 @@ trees2trms opts sg cn as ts0 info = do
|
||||
_ | null ts0 -> checkWarn "No success in cf parsing" >> return []
|
||||
_ | raw -> do
|
||||
ts1 <- return (map cf2trm0 ts0) ----- should not need annot
|
||||
mapM (checkErr . (annotate gr) . trExp) ts1 ---- complicated; often fails
|
||||
checks [
|
||||
mapM (checkErr . (annotate gr) . trExp) ts1 ---- complicated, often fails
|
||||
,checkWarn (unlines ("Raw CF trees:":(map prCFTree ts0))) >> return []
|
||||
]
|
||||
_ -> do
|
||||
let num = optIntOrN opts flagRawtrees 99999
|
||||
let (ts01,rest) = splitAt num ts0
|
||||
|
||||
@@ -35,6 +35,11 @@ mkCFTokVar s = case s of
|
||||
'$':xs@(_:_) -> if last s == '$' then tV (init xs) else tS s
|
||||
_ -> tS s
|
||||
|
||||
mkTokVars :: (String -> [CFTok]) -> String -> [CFTok]
|
||||
mkTokVars tok = map tv . tok where
|
||||
tv (TS s) = mkCFTokVar s
|
||||
tv t = t
|
||||
|
||||
mkLit :: String -> CFTok
|
||||
mkLit s = if (all isDigit s) then (tI s) else (tL s)
|
||||
|
||||
|
||||
Reference in New Issue
Block a user