-- Einfache arithmetische Ausdrücke als zweifach polymorphe Datentypen

data BinBaum tk tb = Atom tb | Knoten (BinBaum tk tb) tk (BinBaum tk tb)
   deriving Show

type EAA = BinBaum Char Int


a,b :: EAA  -- Beispielausdrücke
a = Knoten (Atom 3) '*' (Knoten (Atom 4) '+' (Atom 9)) -- a = 3*(4+9) 
b = Knoten (Knoten (Atom 4) '+' (Atom 9)) '*'  (Atom 3) 

wert :: EAA -> Int
wert (Atom z) = z
wert (Knoten a1 '+' a2) = (wert a1) + (wert a2)
wert (Knoten a1 '*' a2) = (wert a1) * (wert a2)

-- Stapelmaschine zur Auswertung von EAA's

data Befehl = Push Int | Add | Mult  -- Befehlssatz der Stapelmaschine
   deriving Show

type Prog = [Befehl]  -- Programme der Stapelmaschine

makeProg :: EAA -> Prog -- Übersetzer
makeProg(Atom z) = [Push z]
makeProg (Knoten a1 '+' a2) = (makeProg a1) ++ (makeProg a2) ++ [Add]
makeProg (Knoten a1 '*' a2) = (makeProg a1) ++ (makeProg a2) ++ [Mult]

type Stapel = [Int] -- Datenspeicher der Stapelmaschine

data Stapelmaschine = Zustand Prog Stapel -- die Stapelmaschine hat ein Programm- und ein Datenspeicher
   deriving Show

schritt :: Stapelmaschine -> Stapelmaschine -- Zustandsüberführungsfunktion
schritt (Zustand (c:cs) s) = Zustand cs (führAus c s)

führAus :: Befehl -> Stapel -> Stapel -- Befehlsausführung
führAus (Push z) s = z:s
führAus Add (z1:z2:s) = (z2+z1):s
führAus Mult (z1:z2:s) = (z2*z1):s

lade :: Prog -> Stapelmaschine -- Laden eines Programms
lade p = Zustand p []

lauf :: Stapelmaschine -> Stapelmaschine -- Ausführung eines Programms
lauf (Zustand [] s) = Zustand [] s
lauf sm = lauf (schritt sm)

{- Der Wert eines Ausdrucks a kann berechnet werden, indem er in   
   ein Programm der Stapelmaschine übersetzt wird, das geladen und 
   auf der Stapelmaschine ausgeführt wird. 
   Anschließend liegt der Wert auf dem Keller.
-}

eval :: EAA -> Int
eval = readTop . lauf . lade . makeProg

readTop :: Stapelmaschine -> Int
readTop (Zustand p (z:s)) = z
 
dump :: Stapelmaschine -> IO() -- Ansehen eines Programmlaufs
dump z @ (Zustand [] s) = putStr (show z)

dump sm = do putStr (show sm)
             putStr "\n"
             dump (schritt sm)

zeigAuswertung :: EAA -> IO() -- Einzelschrittauswertung eines Ausdrucks
zeigAuswertung = dump . lade . makeProg

test1, test2 :: IO()
test1 = zeigAuswertung a
test2 = zeigAuswertung b