module AETree where

-- liest und prüft einen arithmetischen Ausdruck nach Grammatik G'ae,
-- füllt dabei einen abstrakten Syntaxbaum, welcher auch einen
-- Fehlerfall vorsieht.

import AE_Parser -- aus der Vorlesung...

{-
Mit dem Parsing wird dieser abstrakte Syntaxbaum für Expressions 
gefüllt (ähnlich wie in Modul ProgType):
-}
data TreeExpr = V String
	       | Op Char TreeExpr TreeExpr
	       | Error String
-- Fehlerfall, für Aufgabe 6.4 vorgesehen

-- Show-Instanz, ersetzen durch "deriving Show" für Rohdaten
instance Show TreeExpr where 
    showsPrec _ (V var) = showString var
    showsPrec _ (Op c e1 e2) = showString "(" . 
			       shows e1 . showString (' ':c:" ") . shows e2 .
			       showString ")"
    showsPrec _ (Error s) = showString $ "<error ("++s++")>"

-- Parse-Funktion: 
parseRDTree :: String -> TreeExpr
parseRDTree s = case eTree s of
                 ((l,""):xs) -> l
                 ((l,cs):xs) -> error ("\n\t\t Fehlerhaft: " ++ show l ++ 
				       "\n\teof erwartet, Rest: " ++
				       show cs)
                 _ -> error "Kein Parse. Fehlt eine Klammer am Ende?"

-- Hilfsfunktion für Nonterminale H und G, baut ggf. einen Teilbaum zusammen
buildTree :: TreeExpr -> Maybe (Char,TreeExpr) -> TreeExpr 
buildTree lt more = case more of 
		         Nothing -> lt 
		         Just (op,le) -> Op op lt le 

-- E -> TH, Look-ahead: ["(","a"]
eTree :: Parser Char TreeExpr
eTree = (tTree                 &&& \lt -> 
          hTree                &&& \rest ->
          result ( buildTree lt rest)) 
	.(lacontrol ["(","a"] ) 
	 
-- H -> +TH | eps, Look-ahead: ["+"] | [")",""]
hTree :: Parser Char (Maybe (Char,TreeExpr))
hTree =   lachoice [["+"],[")",""]] 
	          [(tok "+")             &&& \[c] -> 
                   tTree                &&& \lt -> 
                   hTree                &&& \rest ->
                   result (Just (c,buildTree lt rest)) ,
		   result Nothing]

-- T -> FG, Look-ahead: ["(","a"]
tTree :: Parser Char TreeExpr
tTree= (fTree                &&& \lf -> 
          gTree                &&& \rest ->
          result (buildTree lf rest )) 
       .(lacontrol ["(","a"])

-- G -> *FG | eps, Look-ahead: ["*"]   |   ["+",")",""]
gTree :: Parser Char (Maybe (Char,TreeExpr))
gTree = lachoice [["*"],["+",")",""]]
           [((tok "*") &&& \[c] -> 
             fTree                &&& \lf -> 
             gTree                &&& \rest ->
             result (Just (c,buildTree lf rest))), 
	    result Nothing ] 

-- F -> (E) | a, Look-ahead: ["("]  | ["a"] 
fTree :: Parser Char TreeExpr
fTree  = lachoice [["("], ["a"]]
          [((tok "(") &&& \[c] -> 
            eTree     &&& \le -> 
            (tok ")") &&& \c ->
            result le), 
	   (tok "a" &&& \ c -> result (V c))
	  ]