diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -11,7 +11,14 @@ - conv-exe: a grammar format utility for conversion of a readable grammar (.lgrm) format into the Haskell data format (.grm) - Examples: - parser-exe: an arithmetic parser + - ambiguous-exe: an arithmetic parser with the ambiguous grammar but backed by precedence attributes + - error-exe: a demo for error recovery by an interplay between a lexer and a parser through a monadic interface - syncomp-exe: a syntax completion server for Emacs + +### Applications using YAPB: + - Microsoft SmallBasic parser: https://github.com/kwanghoon/sbparser + - Polyrmorphic RPC calculus parser: https://github.com/kwanghoon/polyrpc + - C11 parser: https://github.com/kwanghoon/c11parser ### Download, build, and test ~~~ diff --git a/app/ambiguous/Parser.hs b/app/ambiguous/Parser.hs --- a/app/ambiguous/Parser.hs +++ b/app/ambiguous/Parser.hs @@ -59,7 +59,9 @@ gotoTblFile = "goto_table.txt", grammarFile = "prod_rules.txt", parserSpecFile = "mygrammar.grm", - genparserexe = "yapb-exe" + genparserexe = "yapb-exe", + + synCompSpec = Nothing } diff --git a/app/error/Parser.hs b/app/error/Parser.hs --- a/app/error/Parser.hs +++ b/app/error/Parser.hs @@ -68,7 +68,9 @@ gotoTblFile = "goto_table.txt", grammarFile = "prod_rules.txt", parserSpecFile = "mygrammar.grm", - genparserexe = "yapb-exe" + genparserexe = "yapb-exe", + + synCompSpec = Nothing } diff --git a/app/parser/Parser.hs b/app/parser/Parser.hs --- a/app/parser/Parser.hs +++ b/app/parser/Parser.hs @@ -64,7 +64,9 @@ gotoTblFile = "goto_table.txt", grammarFile = "prod_rules.txt", parserSpecFile = "mygrammar.grm", - genparserexe = "yapb-exe" + genparserexe = "yapb-exe", + + synCompSpec = Nothing } diff --git a/app/syntaxcompletion/Parser.hs b/app/syntaxcompletion/Parser.hs --- a/app/syntaxcompletion/Parser.hs +++ b/app/syntaxcompletion/Parser.hs @@ -46,5 +46,7 @@ gotoTblFile = "goto_table.txt", grammarFile = "prod_rules.txt", parserSpecFile = "mygrammar.grm", - genparserexe = "yapb-exe" + genparserexe = "yapb-exe", + + synCompSpec = Nothing } diff --git a/app/syntaxcompletion/SyntaxCompletion.hs b/app/syntaxcompletion/SyntaxCompletion.hs --- a/app/syntaxcompletion/SyntaxCompletion.hs +++ b/app/syntaxcompletion/SyntaxCompletion.hs @@ -42,12 +42,14 @@ compCandidates <- chooseCompCandidatesFn handleParseError compCandidates - (defaultHandleParseError { + (defaultHandleParseError lexerSpec parserSpec) + { debugFlag=debug, searchMaxLevel=maxLevel, simpleOrNested=isSimpleMode, postTerminalList=[], -- terminalListAfterCursor is set to []! - nonterminalToStringMaybe=Nothing}) + nonterminalToStringMaybe=Nothing + } parseError)) `catch` \lexError -> case lexError :: LexError of _ -> handleLexError diff --git a/src/config/Config.hs b/src/config/Config.hs --- a/src/config/Config.hs +++ b/src/config/Config.hs @@ -29,4 +29,9 @@ Nothing -> error $ "readConfig: unexpected configuration\n" ++ show text else return Nothing - +writeConfig :: Configuration -> IO () +writeConfig config = + writeFile configFileName (show config) + + + diff --git a/src/parserlib/CommonParserUtil.hs b/src/parserlib/CommonParserUtil.hs --- a/src/parserlib/CommonParserUtil.hs +++ b/src/parserlib/CommonParserUtil.hs @@ -15,7 +15,8 @@ , initState, runAutomaton , get, getText , LexError(..), ParseError(..), lpStateFrom - , successfullyParsed, handleLexError, handleParseError) + , successfullyParsed, handleLexError, handleParseError + , SynCompSpec(..)) where import Attrs @@ -68,6 +69,20 @@ -- | - Extended elements : a (E.g., what the lexer and the parser want to share) -- | - Extended effects : m (E.g., typically, IO) +-- | Data structure +-- | (Lexer) ===> LexerSpec (written by applications) +-- | (Parser) ===> ParserSpec (written by applications) +-- | (Automaton) ===> AutomatonSpec (constructed by parsing() and used by runAutomaton) +-- | +-- | (Automaton) ===> ParseError (thrown by the automaton. NotFoundAction | NotFoundGoto +-- | for the parser state on the parse error) +-- | +-- | (Application) ===> HandleParseError (for options set by applications +-- | to control the syntax completer) +-- | +-- | (Syntax completer) ===> CompCandidates (for the syntax completer options +-- | used by compCandidatesFn) + type Line = Int type Column = Int type LexerParserState a = (a, Line, Column, String) -- Lexer and parser states @@ -120,9 +135,13 @@ gotoTblFile :: String, -- ex) gototable.txt grammarFile :: String, -- ex) grammar.txt parserSpecFile :: String, -- ex) mygrammar.grm - genparserexe :: String -- ex) genlrparse-exe + genparserexe :: String, -- ex) genlrparse-exe + synCompSpec :: Maybe SynCompSpec } +data SynCompSpec = + SynCompSpec { isAbleToSearch :: String -> Bool -- terminasls or non-terminals + } -------------------------------------------------------------------------------- -- | Stack -------------------------------------------------------------------------------- @@ -408,11 +427,11 @@ data AutomatonSpec token ast m a = AutomatonSpec { - am_actionTbl :: ActionTable, - am_gotoTbl :: GotoTable, - am_prodRules :: ProdRules, - am_parseFuns :: ParseActionList token ast m a, - am_initState :: Int + am_actionTbl :: ActionTable, + am_gotoTbl :: GotoTable, + am_prodRules :: ProdRules, + am_parseFuns :: ParseActionList token ast m a, + am_initState :: Int } initState = 0 @@ -664,6 +683,8 @@ tokenAttrs = toTokenAttrs tokenAttrList tokenAttrsStr = show tokenAttrs + + synCompSpecMaybe = synCompSpec parserSpec pSpecList = map (\(f,s,t)->f) (parserSpecList parserSpec) pFunList = map (\(f,s,t)->s) (parserSpecList parserSpec) @@ -791,16 +812,19 @@ simpleOrNested :: Bool, postTerminalList :: [Terminal token], nonterminalToStringMaybe :: Maybe (String->String), - presentation :: Int -- 0: default, no transformation. 1: a list of the first symbols + presentation :: Int, -- 0: default, no transformation. 1: a list of the first symbols + hpe_synCompSpec :: Maybe SynCompSpec } -defaultHandleParseError = HandleParseError { +defaultHandleParseError lexerSpec parserSpec = + HandleParseError { debugFlag = False, searchMaxLevel = 1, simpleOrNested = True, postTerminalList = [], nonterminalToStringMaybe = Nothing, - presentation = 0 + presentation = 0, + hpe_synCompSpec = synCompSpec parserSpec } -- | handleParseError @@ -861,17 +885,28 @@ simpleOrNested=isSimple, postTerminalList=terminalListAfterCursor, nonterminalToStringMaybe=_nonterminalToStringMaybe, - presentation=howtopresent})) + presentation=howtopresent, + hpe_synCompSpec=synCompSpecMaybe})) state stk automaton = - let ccOption = CompCandidates { - cc_debugFlag=flag, - cc_printLevel=0, - cc_maxLevel=maxLevel, - cc_simpleOrNested=isSimple, - cc_automaton=automaton, - cc_searchState = initSearchState init_r_level init_gs_level, - cc_r_level = init_r_level, - cc_gs_level = init_gs_level} + let ccOption = + CompCandidates + { + cc_debugFlag=flag, + cc_printLevel=0, + cc_maxLevel=maxLevel, + + cc_r_level = init_r_level, + cc_gs_level = init_gs_level, + + cc_simpleOrNested=isSimple, + cc_automaton=automaton, + cc_searchState = initSearchState init_r_level init_gs_level, + + cc_isAbleToSearch = + case synCompSpecMaybe of + Nothing -> (\sym -> True) -- Every symbol + Just synCompSpec -> isAbleToSearch synCompSpec -- Only those symbols that this function returns true + } in let convFun = case _nonterminalToStringMaybe of diff --git a/src/parserlib/algo/SynCompAlgoBUTree.hs b/src/parserlib/algo/SynCompAlgoBUTree.hs --- a/src/parserlib/algo/SynCompAlgoBUTree.hs +++ b/src/parserlib/algo/SynCompAlgoBUTree.hs @@ -345,6 +345,8 @@ level = cc_printLevel ccOption isSimple = cc_simpleOrNested ccOption automaton = cc_automaton ccOption + + canSearch = cc_isAbleToSearch ccOption actionTable = actTbl automaton gotoTable = gotoTbl automaton @@ -353,7 +355,7 @@ case nub [ (nonterminal,toState) | ((fromState,nonterminal),toState) <- gotoTable - , state==fromState ] of + , state==fromState, canSearch nonterminal ] of [] -> do return [] nontermStateList -> @@ -397,11 +399,13 @@ isSimple = cc_simpleOrNested ccOption automaton = cc_automaton ccOption + canSearch = cc_isAbleToSearch ccOption + actionTable = actTbl automaton gotoTable = gotoTbl automaton productionRules = prodRules automaton in - let cand2 = nub [(terminal,snext) | ((s,terminal),Shift snext) <- actionTable, state==s] + let cand2 = nub [(terminal,snext) | ((s,terminal),Shift snext) <- actionTable, state==s, canSearch terminal] len = length cand2 in do -- debug flag $ prlevel level ++ "[simulShift] " ++ show (cc_searchState ccOption) diff --git a/src/parserlib/algo/SynCompAlgoUtil.hs b/src/parserlib/algo/SynCompAlgoUtil.hs --- a/src/parserlib/algo/SynCompAlgoUtil.hs +++ b/src/parserlib/algo/SynCompAlgoUtil.hs @@ -71,7 +71,9 @@ cc_simpleOrNested :: !Bool, cc_automaton :: !(Automaton token ast), - cc_searchState :: !SearchState + cc_searchState :: !SearchState, + + cc_isAbleToSearch :: String -> Bool } diff --git a/src/util/AVL.hs b/src/util/AVL.hs new file mode 100644 --- /dev/null +++ b/src/util/AVL.hs @@ -0,0 +1,82 @@ +-- | AVL tree implementation +-- | https://www.cs.uleth.ca/~gaur/code/avl.hs + + +module AVL(find,ins,Tree(..)) where + + +data Tree a = Nil | Node !a !(Tree a) !(Tree a) + deriving (Eq,Ord,Show,Read) + +find :: Ord a => a -> Tree a -> Bool +find x Nil = False +find x (Node y l r) + | x==y = True + | xy = find x r + +height :: Tree a -> Integer +height Nil = 0 +height (Node k l r) = 1 + (max (height l) (height r)) + +balanced :: Tree a -> Bool +balanced Nil = True +balanced (Node k l r) | not (balanced l) = False + | not (balanced r) = False + | abs ((height l) - (height r)) > 1 = False + | otherwise = True + +-- balanced (Node 3 (Node 2 (Node 1 Nil Nil) Nil) Nil) + +left :: Tree a -> Tree a +left Nil = error ("left Nil") +left (Node n l r) = l + +right :: Tree a -> Tree a +right Nil = error ("right Nil") +right (Node n l r) = r + +value :: (Ord a) => Tree a -> a +value Nil = error ("value Nil")-- 0 +value (Node n l r) = n + + +ins :: (Ord a) => Tree a -> a -> Tree a +ins Nil a = Node a Nil Nil +ins (Node b l r) k + | b < k = rotate ((Node b l (ins r k))) + | otherwise = rotate (Node b (ins l k) r) + +rotate :: (Ord a) => Tree a -> Tree a +rotate Nil = Nil +rotate (Node n l r) + | not (balanced l) = Node n (rotate l) r + + | not (balanced r) = Node n l (rotate r) + + | (height l) + 1 < (height r) && -- SR RR + (height (left r)) < (height (right r)) = + Node (value r) (Node n l (left r)) (right r) + + | (height r) + 1 < (height l) && -- SR LL + (height (right l)) < (height (left l)) = + Node (value l) (left l) (Node n (right l) r) + + | (height l) + 1 < (height r) && -- DR RL + (height (left r)) > (height (right r)) = + Node (value (left r)) + (Node n l (left (left r))) + (Node (value r) (right (left r)) (right r)) + + | (height r) + 1 < (height l) && -- DR LR + (height (right l)) > (height (left l)) = + Node (value (right l)) + (Node (value l) (left l) (left (right l))) + (Node n (right (right l)) r) + + | otherwise = Node n l r + +buildTree :: (Ord a) => [a] -> Tree a +buildTree [] = Nil +buildTree (x:xs) = foldl ins Nil (x:xs) + diff --git a/src/util/MaxRhsLen.hs b/src/util/MaxRhsLen.hs new file mode 100644 --- /dev/null +++ b/src/util/MaxRhsLen.hs @@ -0,0 +1,38 @@ +module MaxRhsLen (maxRhsLen,maxRhsLen_) where + +import CFG +import Attrs + +import Data.List (sort) + +-- | Calculate the maximum length of RHSs from mygrammar.grm + +maxRhsLen :: String -> IO Int +maxRhsLen file = + do text <- readFile file + let s = read text :: (CFG,TokenAttrs,ProdRuleAttrs,String) + return (last (sort [ length rhs | ProductionRule _ rhs <- pr s ])) + where pr (CFG _ prodrules,_,_,_) = prodrules + + +-- | Calculate the maximum length of RHSs from the text grammar (Temporary) + +maxRhsLen_ :: String -> IO Int +maxRhsLen_ file = + do text <- readFile file + return (last (sort [length (drop 3 list) | list <- map words (lines text)])) + + +-- | Examples + +-- ghci>maxRhsLen "/home/khchoi/work/lang/haskell/sbparser/mygrammar.grm" +-- 9 + +-- ghci>maxRhsLen "/home/khchoi/work/lang/haskell/polyrpc/mygrammar.grm" +-- 8 + +-- ghci>maxRhsLen "/home/khchoi/work/lang/haskell/c11parser/mygrammar.grm" +-- 9 + +-- ghci>maxRhsLen_ "/home/khchoi/work/lang/haskell/happy/hslexer/haskell_parser_grammar.txt" +-- 9 diff --git a/yapb.cabal b/yapb.cabal --- a/yapb.cabal +++ b/yapb.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: f77819b422fe4bf504a61917dc5fbf6875bc35d76c7f3ea16707505b9f6134ed +-- hash: 7c59cf87fbeef808a2e3de7bb410ef94f49b773ab3251ef42e0b5c384972346a name: yapb -version: 0.2.3 +version: 0.2.4 synopsis: Yet Another Parser Builder (YAPB) description: A programmable LALR(1) parser builder system. Please see the README on GitHub at category: parser builder @@ -43,6 +43,7 @@ AutomatonType LoadAutomaton ReadGrammar + MaxRhsLen EmacsServer SynCompInterface Config @@ -53,6 +54,7 @@ SynCompAlgoPEPM SynCompAlgoUtil SynCompAlgorithm + AVL other-modules: Paths_yapb hs-source-dirs: