{-

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 conditional expressions

-}


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

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

parse str = let (succ, len) = parseS str in succ && len == length str


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

--  S -> aC | bAA | epsilon

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

parseS ('a':str) = 
   let (succ,len) = parseC str in 
      if succ then (True, 1+len) else (True, 0)

parseS ('b':str) = 
   let (succ1,len1) = parseA str; (succ2,len2) = parseA (drop len1 str) in
      if succ1 && succ2 then 
         (True, 1+len1+len2) 
      else 
         (True,0)

parseS _ = (True, 0)


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

--  C -> aB | bA

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

parseC ('a':str) = 
   let (succ,len) = parseB str in
      if succ then (True, 1+len) else (False, 0)

parseC ('b':str) = 
   let (succ,len) = parseA str in
      if succ then (True, 1+len) else (False, 0)

parseC _ = (False,0)


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

--  A -> aS | bAAA

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

parseA ('a':str) = 
   let (succ,len) = parseS str in
      if succ then (True, 1+len) else (False, 0)


parseA ('b':str) = 
   let (succ1,len1) = parseA str ; 
       (succ2,len2) = parseA (drop len1 str) ;
       (succ3,len3) = parseA (drop (len1+len2) str)
   in
      if succ1 && succ2 && succ3 then 
         (True, 1+len1+len2+len3)
      else
         (False,0)

parseA _ = (False,0)


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

--  B -> bS | aCB | aBC

parseB :: [Char] -> (Bool, Int)
                      
parseB ('b':str) = let (succ,len) = parseS str in
                      if succ then (True, 1+len) else (False, 0)

parseB ('a':str) = 
   let (succ1,len1) = parseC str; 
       (succ2,len2) = parseB (drop len1 str) 
   in
      if succ1 && succ2 then 
         (True,1+len1+len2) 
      else
         let (succ3,len3) = parseB str; 
             (succ4,len4) = parseC (drop len3 str) 
         in
            if succ3 && succ4 then
               (True,1+len3+len4)
            else
               (False,0)

parseB _ = (False,0)