{-

A recursive descent parser for the strings over {a,b}
with twice as many a's as b's using the grammar:

  S -> aC | bAA | epsilon
  C -> aB | bA
  A -> aS | bAAA
  B -> bS | aCB | aBC

Each parseX function below returns a pair (flag,count) :: (Bool,Int).
  flag indicates whether X can generate a prefix of the string parameter
  count is the length of the prefix

Implemented using Haskell "pattern guards"

-}

-- ----------------------------------------------------------------------------------

-- wrapper function that calls parseS 
-- and checks if S can generate the entire string

parse str 

   |  (True, len) <- parseS str 
   =  len == length str

   |  otherwise
   =  False

-- ----------------------------------------------------------------------------------

--  S -> aC | bAA | epsilon

parseS :: [Char] -> (Bool, Int)

parseS (ch:str) 

   |  'a' <- ch, 
      (True,len) <- parseC str
   =  (True,1+len)


   |  'b' <- ch, 
      (True,len1) <- parseA str, 
      (True,len2) <- parseA (drop len1 str)
   =  (True, 1+len1+len2)

   |  otherwise 
   =  (True,0)

parseS [] = (True,0)


-- ----------------------------------------------------------------------------------

--  C -> aB | bA

parseC :: [Char] -> (Bool, Int)

parseC (ch:str)

   |  'a' <- ch,
      (True,len) <- parseB str
   =  (True,1+len)

   |  'b' <- ch,
      (True,len) <- parseA str
   =  (True,1+len)

   |  otherwise
   =  (False,0)

parseC [] = (False,0)


-- ----------------------------------------------------------------------------------

--  A -> aS | bAAA

parseA :: [Char] -> (Bool, Int)

parseA (ch:str)

   |  'a' <- ch,
      (True,len) <- parseS str
   =  (True,1+len)

   |  'b' <- ch,
      (True,len1) <- parseA str,
      (True,len2) <- parseA (drop len1 str),
      (True,len3) <- parseA (drop (len1+len2) str)
   =  (True,1+len1+len2+len3)

   |  otherwise
   =  (False,0)

parseA [] = (False,0)


-- ----------------------------------------------------------------------------------

--  B -> bS | aCB | aBC

parseB :: [Char] -> (Bool, Int)

parseB (ch:str)

   |  'b' <- ch,
      (True,len) <- parseS str
   =  (True,1+len)

   |  'a' <- ch,
      (True,len1) <- parseC str,
      (True,len2) <- parseB (drop len1 str)
   =  (True,1+len1+len2)

   |  'a' <- ch,
      (True,len1) <- parseB str,
      (True,len2) <- parseC (drop len1 str)
   =  (True,1+len1+len2)

   |  otherwise
   =  (False,0)
                      

parseB [] = (False,0)