yapb 0.1.3 → 0.1.3.1
raw patch · 3 files changed
+228/−82 lines, 3 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
+ CommonParserUtil: AutomatonSpec :: ActionTable -> GotoTable -> ProdRules -> ParseFunList token ast -> Int -> AutomatonSpec token ast
+ CommonParserUtil: HandleParseError :: Bool -> Int -> Bool -> [Terminal token] -> Maybe (String -> String) -> HandleParseError token
+ CommonParserUtil: [am_actionTbl] :: AutomatonSpec token ast -> ActionTable
+ CommonParserUtil: [am_gotoTbl] :: AutomatonSpec token ast -> GotoTable
+ CommonParserUtil: [am_initState] :: AutomatonSpec token ast -> Int
+ CommonParserUtil: [am_parseFuns] :: AutomatonSpec token ast -> ParseFunList token ast
+ CommonParserUtil: [am_prodRules] :: AutomatonSpec token ast -> ProdRules
+ CommonParserUtil: [debugFlag] :: HandleParseError token -> Bool
+ CommonParserUtil: [nonterminalToStringMaybe] :: HandleParseError token -> Maybe (String -> String)
+ CommonParserUtil: [postTerminalList] :: HandleParseError token -> [Terminal token]
+ CommonParserUtil: [searchMaxLevel] :: HandleParseError token -> Int
+ CommonParserUtil: [simpleOrNested] :: HandleParseError token -> Bool
+ CommonParserUtil: data AutomatonSpec token ast
+ CommonParserUtil: data HandleParseError token
+ CommonParserUtil: instance GHC.Classes.Eq CommonParserUtil.EmacsColor
+ CommonParserUtil: instance GHC.Classes.Eq CommonParserUtil.EmacsColorCandidate
+ CommonParserUtil: instance GHC.Show.Show CommonParserUtil.EmacsColorCandidate
+ CommonParserUtil: parsingHaskell :: (TokenInterface token, Typeable token, Typeable ast, Show token, Show ast) => Bool -> ParserSpec token ast -> [Terminal token] -> Maybe token -> IO ast
+ CommonParserUtil: runAutomatonHaskell :: (TokenInterface token, Typeable token, Typeable ast, Show token, Show ast) => Bool -> AutomatonSpec token ast -> [Terminal token] -> Maybe token -> IO ast
- CommonParserUtil: handleParseError :: TokenInterface token => Bool -> Int -> Bool -> [Terminal token] -> ParseError token ast -> IO [EmacsDataItem]
+ CommonParserUtil: handleParseError :: TokenInterface token => HandleParseError token -> ParseError token ast -> IO [EmacsDataItem]
- CommonParserUtil: runAutomaton :: (TokenInterface token, Typeable token, Typeable ast, Show token, Show ast) => Bool -> Int -> ActionTable -> GotoTable -> ProdRules -> ParseFunList token ast -> [Terminal token] -> IO ast
+ CommonParserUtil: runAutomaton :: (TokenInterface token, Typeable token, Typeable ast, Show token, Show ast) => Bool -> AutomatonSpec token ast -> [Terminal token] -> IO ast
Files
- app/syntaxcompletion/SyntaxCompletion.hs +8/−1
- src/parserlib/CommonParserUtil.hs +218/−79
- yapb.cabal +2/−2
app/syntaxcompletion/SyntaxCompletion.hs view
@@ -39,6 +39,13 @@ {- 3. Lexing the rest and computing candidates with it -} do (_, _, terminalListAfterCursor) <- lexingWithLineColumn lexerSpec line column programTextAfterCursor- handleParseError debug maxLevel isSimpleMode terminalListAfterCursor parseError))+ handleParseError+ (HandleParseError {+ debugFlag=debug,+ searchMaxLevel=maxLevel,+ simpleOrNested=isSimpleMode,+ postTerminalList=terminalListAfterCursor,+ nonterminalToStringMaybe=Nothing})+ parseError)) `catch` \lexError -> case lexError :: LexError of _ -> handleLexError
src/parserlib/CommonParserUtil.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE GADTs #-} module CommonParserUtil- ( LexerSpec(..), ParserSpec(..)- , lexing, lexingWithLineColumn, parsing, runAutomaton+ ( LexerSpec(..), ParserSpec(..), AutomatonSpec(..), HandleParseError(..)+ , lexing, lexingWithLineColumn, parsing, runAutomaton, parsingHaskell, runAutomatonHaskell , get, getText , LexError(..), ParseError(..) , successfullyParsed, handleLexError, handleParseError) where@@ -178,9 +178,12 @@ -- ++ prStack stack ++ "\n" ---parsing :: (TokenInterface token, Typeable token, Typeable ast, Show token, Show ast) =>- Bool -> ParserSpec token ast -> [Terminal token] -> IO ast-parsing flag parserSpec terminalList = do+parsing flag parserSpec terminalList =+ parsingHaskell flag parserSpec terminalList Nothing+ +parsingHaskell :: (TokenInterface token, Typeable token, Typeable ast, Show token, Show ast) =>+ Bool -> ParserSpec token ast -> [Terminal token] -> Maybe token -> IO ast+parsingHaskell flag parserSpec terminalList haskellOption = do -- 1. Save the production rules in the parser spec (Parser.hs). writtenBool <- saveProdRules specFileName sSym pSpecList @@ -199,7 +202,14 @@ putStrLn $ "Delete " ++ hashFile removeIfExists hashFile error $ "Error: Empty automation: please rerun"- else do ast <- runAutomaton flag initState actionTbl gotoTbl prodRules pFunList terminalList+ else do ast <- runAutomatonHaskell flag+ (AutomatonSpec {+ am_initState=initState,+ am_actionTbl=actionTbl,+ am_gotoTbl=gotoTbl,+ am_prodRules=prodRules,+ am_parseFuns=pFunList })+ terminalList haskellOption -- putStrLn "done." -- It was for the interafce with Java-version RPC calculus interpreter. return ast @@ -314,19 +324,39 @@ -- Automaton +data AutomatonSpec token ast =+ AutomatonSpec {+ am_actionTbl :: ActionTable,+ am_gotoTbl :: GotoTable,+ am_prodRules :: ProdRules,+ am_parseFuns :: ParseFunList token ast,+ am_initState :: Int+ }+ initState = 0 type ParseFunList token ast = [ParseFun token ast] -runAutomaton :: (TokenInterface token, Typeable token, Typeable ast, Show token, Show ast) =>- Bool -> Int -> - {- static part -}- ActionTable -> GotoTable -> ProdRules -> ParseFunList token ast -> +runAutomaton flag amSpec terminalList =+ runAutomatonHaskell flag amSpec {- initState actionTbl gotoTbl prodRules pFunList-} terminalList Nothing++runAutomatonHaskell :: (TokenInterface token, Typeable token, Typeable ast, Show token, Show ast) =>+ Bool -> + {- static part ActionTable -> GotoTable -> ProdRules -> ParseFunList token ast -> -}+ AutomatonSpec token ast -> {- dynamic part -} [Terminal token] ->+ {- haskell parser specific option -}+ Maybe token -> {- AST -} IO ast-runAutomaton flag initState actionTbl gotoTbl prodRules pFunList terminalList = do+runAutomatonHaskell flag (rm_spec @ AutomatonSpec {+ am_initState=initState,+ am_actionTbl=actionTbl,+ am_gotoTbl=gotoTbl,+ am_prodRules=prodRules,+ am_parseFuns=pFunList+ }) terminalList haskellOption = do let initStack = push (StkState initState) emptyStack run terminalList initStack @@ -335,24 +365,44 @@ run terminalList stack = do let state = currentState stack let terminal = head terminalList- let text = tokenTextFromTerminal terminal- let action =- case lookupActionTable actionTbl state terminal of- Just action -> action- Nothing -> throw (NotFoundAction terminal state stack actionTbl gotoTbl prodRules terminalList)- -- error $ ("Not found in the action table: "- -- ++ terminalToString terminal)- -- ++ " : "- -- ++ show (state, tokenTextFromTerminal terminal)- -- ++ "\n" ++ prStack stack ++ "\n"- + case lookupActionTable actionTbl state terminal of+ Just action -> do+ -- putStrLn $ terminalToString terminal {- debug -}+ runAction state terminal action terminalList stack+ + Nothing -> do+ putStrLn $ "lookActionTable failed (1st) with: " ++ show (terminalToString terminal)+ case haskellOption of+ Just extraToken -> do+ let terminal_close_brace = Terminal+ (fromToken extraToken)+ (terminalToLine terminal)+ (terminalToCol terminal)+ (Just extraToken)+ case lookupActionTable actionTbl state terminal_close_brace of+ Just action -> do+ -- putStrLn $ terminalToString terminal_close_brace {- debug -}+ putStrLn $ "lookActionTable succeeded (2nd) with: " ++ terminalToString terminal_close_brace+ runAction state terminal_close_brace action (terminal_close_brace : terminalList) stack+ + Nothing -> do+ putStrLn $ "lookActionTable failed (2nd) with: " ++ terminalToString terminal_close_brace+ throw (NotFoundAction terminal state stack actionTbl gotoTbl prodRules terminalList)+ -- Nothing -> throw (NotFoundAction terminal_close_brace state stack actionTbl gotoTbl prodRules+ -- (terminal_close_brace : terminalList))+ + Nothing -> throw (NotFoundAction terminal state stack actionTbl gotoTbl prodRules terminalList)++ -- separated to support the haskell layout rule+ runAction state terminal action terminalList stack = do debug flag ("\nState " ++ show state)- debug flag ("Token " ++ text)+ debug flag ("Token " ++ tokenTextFromTerminal terminal) debug flag ("Stack " ++ prStack stack) case action of Accept -> do debug flag "Accept"+ putStrLn $ terminalToString terminal {- debug -} case stack !! 1 of StkNonterminal (Just ast) _ -> return ast@@ -361,6 +411,7 @@ Shift toState -> do debug flag ("Shift " ++ show toState)+ putStrLn $ terminalToString terminal {- debug -} let stack1 = push (StkTerminal (head terminalList)) stack let stack2 = push (StkState toState) stack1@@ -384,10 +435,6 @@ case lookupGotoTable gotoTbl topState lhs of Just state -> state Nothing -> throw (NotFoundGoto topState lhs stack actionTbl gotoTbl prodRules terminalList)- -- error $ ("Not found in the goto table: ")- -- ++ " : "- -- ++ show (topState,lhs) ++ "\n"- -- ++ prStack stack ++ "\n" let stack2 = push (StkNonterminal (Just ast) lhs) stack1 let stack3 = push (StkState toState) stack2@@ -403,29 +450,37 @@ data Candidate = -- Todo: data Candidate vs. data EmacsDataItem = ... | Candidate String TerminalSymbol String | NonterminalSymbol String- deriving (Show,Eq)+ deriving Eq +instance Show Candidate where+ showsPrec p (TerminalSymbol s) = (++) $ "Terminal " ++ s+ showsPrec p (NonterminalSymbol s) = (++) $ "Nonterminal " ++ s+ data Automaton token ast = Automaton { actTbl :: ActionTable, gotoTbl :: GotoTable, prodRules :: ProdRules }++data CompCandidates token ast = CompCandidates {+ cc_debugFlag :: Bool,+ cc_searchMaxLevel :: Int,+ cc_simpleOrNested :: Bool,+ cc_automaton :: Automaton token ast+ } compCandidates :: (TokenInterface token, Typeable token, Typeable ast, Show token, Show ast) =>- Bool -- debug- -> Int -- maximum search depth level- -> Bool -- simple or nested+ CompCandidates token ast -> Int -> [Candidate] -> Int- -> Automaton token ast -> Stack token ast -> IO [[Candidate]] -compCandidates flag maxLevel isSimple level symbols state automaton stk = do- compGammasDfs flag maxLevel isSimple level symbols state automaton stk []+compCandidates ccOption level symbols state stk = do+ compGammasDfs ccOption level symbols state stk [] -- gammas <- compGammasDfs isSimple level symbols state automaton stk [] -- if isSimple -- then return gammas@@ -433,31 +488,41 @@ compGammasDfs :: (TokenInterface token, Typeable token, Typeable ast, Show token, Show ast) =>- Bool- -> Int- -> Bool+ CompCandidates token ast -> Int -> [Candidate] -> Int- -> Automaton token ast -> Stack token ast -> [(Int, Stack token ast, String)] -> IO [[Candidate]] -compGammasDfs flag maxLevel isSimple level symbols state automaton stk history =+compGammasDfs ccOption level symbols state stk history =+ let flag = cc_debugFlag ccOption+ maxLevel = cc_searchMaxLevel ccOption+ isSimple = cc_simpleOrNested ccOption+ automaton = cc_automaton ccOption+ + actionTable = actTbl automaton+ gotoTable = gotoTbl automaton+ productionRules = prodRules automaton+ in if level > maxLevel then return (if null symbols then [] else [symbols]) else checkCycle flag False level state stk "" history- (\history -> - case nub [prnum | ((s,lookahead),Reduce prnum) <- actTbl automaton, state==s] of+ (\history ->+ {- 1. Reduce -}+ case nub [prnum | ((s,lookahead),Reduce prnum) <- actionTable, state==s] of [] ->- case nub [(nonterminal,toState) | ((fromState,nonterminal),toState) <- gotoTbl automaton, state==fromState] of+ {- 2. Goto table -}+ case nub [(nonterminal,toState) | ((fromState,nonterminal),toState) <- gotoTable, state==fromState] of [] ->- if length [True | ((s,lookahead),Accept) <- actTbl automaton, state==s] >= 1+ {- 3. Accept -}+ if length [True | ((s,lookahead),Accept) <- actionTable, state==s] >= 1 then do return []- else let cand2 = nub [(terminal,snext) | ((s,terminal),Shift snext) <- actTbl automaton, state==s] in+ {- 4. Shift -}+ else let cand2 = nub [(terminal,snext) | ((s,terminal),Shift snext) <- actionTable, state==s] in let len = length cand2 in case cand2 of [] -> return []@@ -477,7 +542,7 @@ debug flag $ prlevel level ++ "Goto/Shift symbols: " ++ show (symbols++[TerminalSymbol terminal]) debug flag $ prlevel level ++ "Stack " ++ prStack stk2 debug flag $ ""- compGammasDfs flag maxLevel isSimple (level+1) (symbols++[TerminalSymbol terminal]) snext automaton stk2 history1) )+ compGammasDfs ccOption (level+1) (symbols++[TerminalSymbol terminal]) snext stk2 history1) ) (zip cand2 [1..]) return $ concat listOfList nontermStateList -> do@@ -499,7 +564,7 @@ debug flag $ prlevel level ++ "Stack " ++ prStack stk2 debug flag $ "" - compGammasDfs flag maxLevel isSimple (level+1) (symbols++[NonterminalSymbol nonterminal]) snext automaton stk2 history1) )+ compGammasDfs ccOption (level+1) (symbols++[NonterminalSymbol nonterminal]) snext stk2 history1) ) (zip nontermStateList [1..]) return $ concat listOfList @@ -507,7 +572,7 @@ let len = length prnumList debug flag $ prlevel level ++ "# of prNumList to reduce: " ++ show len ++ " at State " ++ show state- debug flag $ prlevel (level+1) ++ show [ (prodRules automaton) !! prnum | prnum <- prnumList ]+ debug flag $ prlevel (level+1) ++ show [ productionRules !! prnum | prnum <- prnumList ] -- let aCandidate = if null symbols then [] else [symbols] -- if isSimple@@ -520,16 +585,25 @@ (\history1 -> do debug flag $ prlevel level ++ "State " ++ show state ++ "[" ++ show i ++ "/" ++ show len ++ "]" debug flag $ prlevel level ++ "REDUCE" ++ " prod #" ++ show prnum- debug flag $ prlevel level ++ show ((prodRules automaton) !! prnum)+ debug flag $ prlevel level ++ show (productionRules !! prnum) debug flag $ prlevel level ++ "Goto/Shift symbols: " ++ show symbols debug flag $ prlevel level ++ "Stack " ++ prStack stk debug flag $ ""- compGammasDfsForReduce flag maxLevel level isSimple symbols state automaton stk history1 prnum)) )+ compGammasDfsForReduce ccOption level symbols state stk history1 prnum)) ) (zip prnumList [1..]) return $ concat listOfList ) -compGammasDfsForReduce flag maxLevel level isSimple symbols state automaton stk history prnum = - let prodrule = (prodRules automaton) !! prnum+compGammasDfsForReduce ccOption level symbols state stk history prnum = + let flag = cc_debugFlag ccOption+ maxLevel = cc_searchMaxLevel ccOption+ isSimple = cc_simpleOrNested ccOption+ automaton = cc_automaton ccOption+ + actionTable = actTbl automaton+ gotoTable = gotoTbl automaton+ productionRules = prodRules automaton+ in+ let prodrule = productionRules !! prnum lhs = fst prodrule rhs = snd prodrule @@ -537,7 +611,8 @@ in if ( {- rhsLength == 0 || -} (rhsLength > length symbols) ) == False then do- debug flag $ prlevel level ++ "[LEN COND: False] length rhs > length symbols: NOT " ++ show rhsLength ++ ">" ++ show (length symbols)+ debug flag $ prlevel level ++ "[LEN COND: False] length rhs > length symbols: NOT "+ ++ show rhsLength ++ ">" ++ show (length symbols) debug flag $ prlevel (level+1) ++ show symbols debug flag $ prlevel level return [] -- Todo: (if null symbols then [] else [symbols])@@ -545,12 +620,14 @@ let stk1 = drop (rhsLength*2) stk let topState = currentState stk1 let toState =- case lookupGotoTable (gotoTbl automaton) topState lhs of+ case lookupGotoTable gotoTable topState lhs of Just state -> state- Nothing -> error $ "[compGammasDfsForReduce] Must not happen: lhs: " ++ lhs ++ " state: " ++ show topState+ Nothing -> error $ "[compGammasDfsForReduce] Must not happen: lhs: "+ ++ lhs ++ " state: " ++ show topState let stk2 = push (StkNonterminal Nothing lhs) stk1 -- ast let stk3 = push (StkState toState) stk2- debug flag $ prlevel level ++ "GOTO after REDUCE: " ++ show topState ++ " " ++ lhs ++ " " ++ show toState+ debug flag $ prlevel level ++ "GOTO after REDUCE: "+ ++ show topState ++ " " ++ lhs ++ " " ++ show toState debug flag $ prlevel level ++ "Goto/Shift symbols: " ++ "[]" debug flag $ prlevel level ++ "Stack " ++ prStack stk3 debug flag $ ""@@ -560,7 +637,7 @@ if isSimple then return (if null symbols then [] else [symbols])- else do listOfList <- compGammasDfs flag maxLevel isSimple (level+1) [] toState automaton stk3 history+ else do listOfList <- compGammasDfs ccOption (level+1) [] toState stk3 history return (if null symbols then listOfList else (symbols : map (symbols ++) listOfList)) -- | Cycle checking@@ -587,53 +664,115 @@ handleLexError :: IO [EmacsDataItem] handleLexError = return [SynCompInterface.LexError] +data HandleParseError token = HandleParseError {+ debugFlag :: Bool,+ searchMaxLevel :: Int,+ simpleOrNested :: Bool,+ postTerminalList :: [Terminal token],+ nonterminalToStringMaybe :: Maybe (String->String)+ }+ -- | handleParseError-handleParseError :: TokenInterface token => Bool -> Int -> Bool -> [Terminal token] -> ParseError token ast -> IO [EmacsDataItem]-handleParseError flag maxLevel isSimple terminalListAfterCursor parseError =- unwrapParseError flag maxLevel isSimple terminalListAfterCursor parseError+-- handleParseError :: TokenInterface token => Bool -> Int -> Bool -> [Terminal token] -> ParseError token ast -> IO [EmacsDataItem]+-- handleParseError flag maxLevel isSimple terminalListAfterCursor parseError =+-- unwrapParseError flag maxLevel isSimple terminalListAfterCursor parseError -unwrapParseError flag maxLevel isSimple terminalListAfterCursor (NotFoundAction _ state stk actTbl gotoTbl prodRules terminalList) =- arrivedAtTheEndOfSymbol flag maxLevel isSimple terminalListAfterCursor state stk actTbl gotoTbl prodRules terminalList-unwrapParseError flag maxLevel isSimple terminalListAfterCursor (NotFoundGoto state _ stk actTbl gotoTbl prodRules terminalList) =- arrivedAtTheEndOfSymbol flag maxLevel isSimple terminalListAfterCursor state stk actTbl gotoTbl prodRules terminalList+handleParseError :: TokenInterface token => HandleParseError token -> ParseError token ast -> IO [EmacsDataItem]+handleParseError hpeOption parseError = unwrapParseError hpeOption parseError+ +unwrapParseError hpeOption (NotFoundAction _ state stk _actTbl _gotoTbl _prodRules terminalList) = do+ let automaton = Automaton {actTbl=_actTbl, gotoTbl=_gotoTbl, prodRules=_prodRules}+ arrivedAtTheEndOfSymbol hpeOption state stk automaton terminalList+unwrapParseError hpeOption (NotFoundGoto state _ stk _actTbl _gotoTbl _prodRules terminalList) = do+ let automaton = Automaton {actTbl=_actTbl, gotoTbl=_gotoTbl, prodRules=_prodRules}+ arrivedAtTheEndOfSymbol hpeOption state stk automaton terminalList -arrivedAtTheEndOfSymbol flag maxLevel isSimple terminalListAfterCursor state stk _actTbl _gotoTbl _prodRules terminalList =+arrivedAtTheEndOfSymbol hpeOption state stk automaton terminalList = do if length terminalList == 1 then do -- [$]- _handleParseError flag maxLevel isSimple terminalListAfterCursor state stk _actTbl _gotoTbl _prodRules- else+ _handleParseError hpeOption state stk automaton+ else do+ putStrLn $ "length terminalList /= 1 : " ++ show (length terminalList)+ mapM_ (\t -> putStrLn $ terminalToString $ t) terminalList return [SynCompInterface.ParseError (map terminalToString terminalList)] -_handleParseError flag maxLevel isSimple terminalListAfterCursor state stk _actTbl _gotoTbl _prodRules = do- let automaton = Automaton {actTbl=_actTbl, gotoTbl=_gotoTbl, prodRules=_prodRules}- candidateListList <- compCandidates flag maxLevel isSimple 0 [] state automaton stk- let colorListList =- [ filterCandidates candidateList terminalListAfterCursor | candidateList <- candidateListList ]+_handleParseError+ (hpeOption @ HandleParseError {+ debugFlag=flag,+ searchMaxLevel=maxLevel,+ simpleOrNested=isSimple,+ postTerminalList=terminalListAfterCursor,+ nonterminalToStringMaybe=_nonterminalToStringMaybe})+ state stk automaton = do+ let ccOption = CompCandidates {+ cc_debugFlag=flag,+ cc_searchMaxLevel=maxLevel,+ cc_simpleOrNested=isSimple,+ cc_automaton=automaton }+ candidateListList <- compCandidates ccOption 0 [] state stk+ let colorListList_symbols =+ [ filterCandidates candidateList terminalListAfterCursor+ | candidateList <- candidateListList ]+ let convFun =+ case _nonterminalToStringMaybe of+ Nothing -> \s -> "..."+ Just fn -> fn+ let colorListList_ = map (stringfyCandidates convFun) colorListList_symbols+ let colorListList = map collapseCandidates colorListList_ let strList = nub [ concatStrList strList | strList <- map (map showEmacsColor) colorListList ] let rawStrListList = nub [ strList | strList <- map (map showRawEmacsColor) colorListList ]- debug flag $ show $ map (\x -> (show x ++ "\n")) rawStrListList -- mapM_ (putStrLn . show) rawStrListList+ debug flag $ showConcat $ map (\x -> (show x ++ "\n")) colorListList_symbols+ debug flag $ showConcat $ map (\x -> (show x ++ "\n")) rawStrListList -- mapM_ (putStrLn . show) rawStrListList return $ map Candidate strList-+ + where+ showConcat [] = ""+ showConcat (s:ss) = s ++ " " ++ showConcat ss+ -- | Filter the given candidates with the following texts data EmacsColor = Gray String Line Column -- Overlapping with some in the following text | White String -- Not overlapping- deriving Show+ deriving (Show, Eq) -filterCandidates :: (TokenInterface token) => [Candidate] -> [Terminal token] -> [EmacsColor]+-- for debugging EmacsColor in terms of symbols before they are stringfied+data EmacsColorCandidate =+ GrayCandidate Candidate Line Column -- Overlapping with some in the following text+ | WhiteCandidate Candidate -- Not overlapping+ deriving Eq++instance Show EmacsColorCandidate where+ showsPrec p (GrayCandidate c lin col) = (++) $ "Gray " ++ show c+ showsPrec p (WhiteCandidate c) = (++) $ "White " ++ show c++filterCandidates :: (TokenInterface token) => [Candidate] -> [Terminal token] -> [EmacsColorCandidate] filterCandidates candidates terminalListAfterCursor = f candidates terminalListAfterCursor [] where f (a:alpha) (b:beta) accm- | equal a b = f alpha beta (Gray (strCandidate a) (terminalToLine b) (terminalToCol b) : accm)- | otherwise = f alpha (b:beta) (White (strCandidate a) : accm)+ | equal a b = f alpha beta (GrayCandidate a (terminalToLine b) (terminalToCol b) : accm)+ | otherwise = f alpha (b:beta) (WhiteCandidate a : accm) f [] beta accm = reverse accm- f (a:alpha) [] accm = f alpha [] (White (strCandidate a) : accm)+ f (a:alpha) [] accm = f alpha [] (WhiteCandidate a : accm) equal (TerminalSymbol s1) (Terminal s2 _ _ _) = s1==s2 equal (NonterminalSymbol s1) _ = False +stringfyCandidates :: (String -> String) -> [EmacsColorCandidate] -> [EmacsColor]+stringfyCandidates convFun candidates = map stringfyCandidate candidates+ where+ stringfyCandidate (GrayCandidate sym line col) = Gray (strCandidate sym) line col+ stringfyCandidate (WhiteCandidate sym) = White (strCandidate sym)+ strCandidate (TerminalSymbol s) = s- strCandidate (NonterminalSymbol s) = "..."+ strCandidate (NonterminalSymbol s) = convFun s -- "..." -- ++ s ++ "..."++collapseCandidates [] = []+collapseCandidates [a] = [a]+collapseCandidates ((Gray "..." l1 c1) : (Gray "..." l2 c2) : cs) =+ collapseCandidates ((Gray "..." l2 c2) : cs)+collapseCandidates ((White "...") : (White "...") : cs) =+ collapseCandidates ((White "...") : cs) +collapseCandidates (a:b:cs) = a : collapseCandidates (b:cs) -- | Utilities showSymbol (TerminalSymbol s) = s
yapb.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 859129ea79d8fa58a86693919544d22f7730f727ef3cc4358ce3f31c25db35fb+-- hash: 16df070449e5bdf4422c57c84ee5baa14a57cd1c98ab276c87e1e250f47fe403 name: yapb-version: 0.1.3+version: 0.1.3.1 synopsis: Yet Another Parser Builder (YAPB) description: A programmable LALR(1) parser builder system. Please see the README on GitHub at <https://github.com/kwanghoon/yapb#readme> category: parser builder