-- Datentyp für While-Programme gemäß Übung 6 GdC

module ProgType where

import List(transpose)

--   Programm:      Name    Deklarationen  Anweisungen
data Program_ = Prog String  [(Var,Type_)]     [Stmt]

data Type_ = I | B 

type Var = String 

data Stmt = Print_ Expr
	  | Assign_ Var Expr
	  | If_ Cond Stmt
	  | While_ Cond Stmt
          | Block_ [Stmt]

data Cond = Rel RelOp_ Expr Expr 
	  | And Cond Cond 
	  | Or Cond Cond

data RelOp_ = Eq | NEq | LE | LEq | GR | GEq 
--           =    !=    <    <=     >   >=

data Expr = V Var 
	  | N Int 
	  | Op Char Expr Expr

------------------------ Show ---------------------------------

instance Show Program_ where
	 showsPrec _ (Prog name vars stmts) = showString ("program "++name ++ "\n vars: ") .
					      shows vars . showString "\n" .
					      shows stmts
instance Show Type_ where
    showsPrec _ I = shows "Int"
    showsPrec _ B = shows "Bool"

instance Show Stmt where
    showsPrec _ stmt x = show_stmts "" [stmt] ++ x
    showList stmts x = show_stmts "" stmts ++ x

instance Show Cond where
    showsPrec _ (Rel op e1 e2) = shows e1 . shows op . shows e2
    showsPrec _ (And b1 b2) = showsBrackets b1 b2 '&'
    showsPrec _ (Or  b1 b2) = showsBrackets b1 b2 '|'

instance Show RelOp_ where
    showsPrec _ Eq = showString " = "
    showsPrec _ NEq = showString " != "
    showsPrec _ LE = showString " < "
    showsPrec _ LEq = showString " <= "
    showsPrec _ GR = showString " > "
    showsPrec _ GEq = showString " >= "

instance Show Expr where 
    showsPrec _ (V var) = showString var
    showsPrec _ (N int) = shows int
    showsPrec _ (Op c e1 e2) = showsBrackets e1 e2 c
			       
showsBrackets :: (Show a) => a -> a -> Char -> ShowS
showsBrackets x1 x2 op = showString "(" .
			 shows x1 . showString (' ':op:" ") .
			 shows x2 . showString ")"

-- indentation function:
show_stmts :: String -> [Stmt] -> String
show_stmts _ [] = ""
show_stmts ind ((Print_ e ):ss)    = ind ++ "print " ++ show e ++ rest
  where rest = "\n" ++ show_stmts ind ss
show_stmts ind ((Assign_ st e):ss)    = ind ++ st ++ " := " ++ (show e) ++ rest
  where rest = "\n" ++ show_stmts ind ss
show_stmts ind ((If_ e s1 ):ss) = ind ++ "if "++(show e)++" then \n" ++
                               (show_stmts ('\t':ind) [s1]) ++ rest
  where rest = "\n" ++ show_stmts ind ss
show_stmts ind ((While_ c st):ss) = ind ++ "while "++(show c)++" do\n"++
                                   (show_stmts ('\t':ind) [st])++rest
  where rest = "\n" ++ show_stmts ind ss
show_stmts ind ((Block_ sts):ss) = ind ++ "{\n" ++ 
                                   (show_stmts ('\t':ind) sts)++
                                   ind ++ "}" ++ rest
  where rest = "\n" ++ show_stmts ind ss