{-  CSci 450: Organization of Programming Languages
    Recursive Descent Parser Example (Incomplete)
    Fall 2017 
    H. Conrad Cunningham

1234567890123456789012345678901234567890123456789012345678901234567890

2017-06-09: Early exploratory version
2017-07-10: Corrected [Token] return from last failure
2017-11-27: Added a few comments for class

Note: No test script available

-}

module ParserS
    ( parse, parseS, parseA, parseB, parseC,
      parseD, parseE, parseF, parseChar     )
where

{-  Example Context-Free Grammar
    S ::= A | B
    A ::= C D
    B ::= { E } 
    C ::= [ F ]
    D ::= '1' | '@' S
    E ::= '3'
    F ::= '2'
-}

-- Outer-layer parser
parse :: String -> Bool
parse xs =
    case parseS xs of
        (True,  []) -> True
        (_,     _ ) -> False

-- Alternative: S ::= A | B
parseS :: String -> (Bool,String) 
parseS xs = 
    case parseA xs of              -- try A
        (True,  ys) -> (True, ys)
        (False, _ ) ->
            case parseB xs of      -- else try B
                (True, ys) -> (True,  ys)
                (False, _) -> (False, xs)
                -- nest any other alternatives

-- Sequencing: A ::= C D
parseA :: String -> (Bool,String) 
parseA xs =
    case parseC xs of   -- try C
        (True,  ys) ->  -- then try D
            case parseD ys of
                (True, zs) -> (True,  zs)
                (False, _) -> (False, xs)
                -- nest any other alternatives
        (False, _ ) -> (False,xs) 

-- Repitition: B ::= { E } 
parseB :: String -> (Bool,String) 
parseB xs =
    case parseE xs of              -- try E
        (True,  ys) -> parseB ys   -- try again
        (False, ys) -> (True,xs)   -- stop

-- Option: C ::= [ F ]
parseC :: String -> (Bool,String)  -- [ F ]
parseC xs =
    case parseF xs of              -- try F
        (True,  ys) -> (True,ys) 
        (False, _ ) -> (True,xs)

-- Combines alternative, sequence: D ::= '1' | '@' S
-- Refactor into two rules
--     D  ::= '1' | DS 
--     DS ::= '@' S 
-- Function below combines by using two legs
parseD :: String -> (Bool,String)  -- '1' | '@' S
parseD ('1':xs) = (True, xs)       -- try '1' (shortcut)
parseD ('@':xs) =                  -- try '@' (shortcut)
    case parseS xs of              -- try S
        (True,  ys) -> (True, ys)
        (False, _ ) -> (False,xs) 
parseD xs      = (False, xs)

-- Base case: E ::= '3'
parseE xs = parseChar '3' xs

-- Base case: F ::= '2'
parseF xs = parseChar '2' xs

-- For future use: Character parser constructor
parseChar :: Char -> String -> (Bool,String)
parseChar c (x:xs')
    | x == c   = (True, xs')
parseChar _ xs = (False,xs )