search with filtered symbols; write config

app/ambiguous/Parser.hs

@@ -59,7 +59,9 @@ parserSpec = ParserSpec
     gotoTblFile    = "goto_table.txt",
     grammarFile    = "prod_rules.txt",
     parserSpecFile = "mygrammar.grm",
-    genparserexe   = "yapb-exe"
+    genparserexe   = "yapb-exe",
+
+    synCompSpec = Nothing
   }
 
 

app/error/Parser.hs

@@ -68,7 +68,9 @@ parserSpec = ParserSpec
     gotoTblFile    = "goto_table.txt",
     grammarFile    = "prod_rules.txt",
     parserSpecFile = "mygrammar.grm",
-    genparserexe   = "yapb-exe"
+    genparserexe   = "yapb-exe",
+
+    synCompSpec = Nothing
   }
 
 

app/parser/Parser.hs

@@ -64,7 +64,9 @@ parserSpec = ParserSpec
     gotoTblFile    = "goto_table.txt",
     grammarFile    = "prod_rules.txt",
     parserSpecFile = "mygrammar.grm",
-    genparserexe   = "yapb-exe"
+    genparserexe   = "yapb-exe",
+
+    synCompSpec = Nothing
   }
 
 

app/syntaxcompletion/Parser.hs

@@ -46,5 +46,7 @@ parserSpec = ParserSpec
     gotoTblFile = "goto_table.txt",
     grammarFile = "prod_rules.txt",
     parserSpecFile = "mygrammar.grm",
-    genparserexe = "yapb-exe"
+    genparserexe = "yapb-exe",
+
+    synCompSpec = Nothing
   }

app/syntaxcompletion/SyntaxCompletion.hs

@@ -42,12 +42,14 @@ computeCand debug programTextUptoCursor programTextAfterCursor isSimpleMode =
                  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

package.yaml

@@ -1,5 +1,5 @@
 name:                yapb
-version:             0.2.3
+version:             0.2.4
 github:              "kwanghoon/yapb"
 license:             BSD3
 author:              "Kwanghoon Choi"
@@ -53,6 +53,7 @@ library:
    - AutomatonType
    - LoadAutomaton
    - ReadGrammar
+   - MaxRhsLen
    - EmacsServer
    - SynCompInterface
    - Config
@@ -63,6 +64,7 @@ library:
    - SynCompAlgoPEPM
    - SynCompAlgoUtil
    - SynCompAlgorithm
+   - AVL
 
   dependencies:
   - regex-tdfa    >= 1.3.1 && < 1.4

src/config/Config.hs

@@ -29,4 +29,9 @@ readConfig =
                  Nothing -> error $ "readConfig: unexpected configuration\n" ++ show text
        else return Nothing
 
-
+writeConfig :: Configuration -> IO ()
+writeConfig config =
+  writeFile configFileName (show config)
+
+
+

src/parserlib/CommonParserUtil.hs

@@ -15,7 +15,8 @@ module CommonParserUtil
   , initState, runAutomaton
   , get, getText
   , LexError(..), ParseError(..), lpStateFrom
-  , successfullyParsed, handleLexError, handleParseError)
+  , successfullyParsed, handleLexError, handleParseError
+  , SynCompSpec(..))
 where
 
 import Attrs
@@ -68,6 +69,20 @@ import Text.Printf
 -- |  - 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 @@ data ParserSpec token ast m a =
                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 @@ lpStateFrom (NotFoundGoto   _ _ _ _ _ _ lpstate _) = lpstate
 
 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 @@ parsing flag parserSpec init_lp_state lexer eot = do
 
     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 @@ data HandleParseError token = HandleParseError {
     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 @@ _handleParseError
       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

src/parserlib/algo/SynCompAlgoBUTree.hs

@@ -345,6 +345,8 @@ simulGoto ccOption symbols state stk =
       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 @@ simulGoto ccOption symbols state stk =
 
         case nub [ (nonterminal,toState)
                  | ((fromState,nonterminal),toState) <- gotoTable
-                 , state==fromState ] of
+                 , state==fromState,  canSearch nonterminal ] of
           [] -> do return []
 
           nontermStateList ->
@@ -397,11 +399,13 @@ simulShift ccOption symbols state stk =
       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)
 

src/parserlib/algo/SynCompAlgoUtil.hs

@@ -71,7 +71,9 @@ data CompCandidates token ast = CompCandidates {
 
     cc_simpleOrNested :: !Bool,
     cc_automaton :: !(Automaton token ast),
-    cc_searchState :: !SearchState
+    cc_searchState :: !SearchState,
+
+    cc_isAbleToSearch :: String -> Bool 
   }
 
 

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
+  | x<y  = find x l
+  | x>y  = 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)
+

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