module Aufgabe10 where

import IO


-- main = do putStr [y | y <- hGetLine stdin]

main::IO() -- blind IO, leader of the gods, plays a main part on the disc ...
main = do n <- (inOut (toString.interpret.Aufgabe10.filter.tokenize)); putStrLn ((show n)++" Zeilen bearbeitet") 


-- Output: 

{- hvr
inOut f = do l <- getLine 
             if l == "end"
               then return 0
               else do putStrLn (f l)
                       n <- inOut f
                       return (n+1)
-}

-- so there aren't too many alternatives. gnah.
-- what's wrong with a helper function inOutc f i?

inOut:: (String->String)-> IO Integer
inOut f = do  line <- (hGetLine stdin)
              if (line /= "end") 
                then do hPutStrLn stdout (f line)
                        sdkf <- (inOut f) 
                        return (sdkf + 1)
                else return 0 


-- map f (takeWhile (/= "end") (hGetLine stdin))

data MyToken a = Minus | Border | MInvalid | MMult | MAdd | MFak | MPot | MValue Integer
	deriving (Eq, Show)

data Token a = Invalid | Mult | Add | Fak | Pot | Value Integer
	deriving (Eq, Show)

tokenize::String->[Token a]
tokenize a = tokenize' a [] where 
  tokenlist = [('+',Add),('*',Mult),('!',Fak),('^',Pot)]
  tokenize' [] out = out
  tokenize' (c:a) out = out ++ (maybe (tokenizesym (c:a) out) (\x -> [x] ++ tokenize' a []) (lookup c tokenlist))
  tokenizesym (c:a) out = if isSpace c 
                          then (tokenize' a out) 
                          else if (isDigit c) || ((c == '-') && a /= [] && isDigit (head a))
                               then out ++ (tokenizenum (c:a) out) 
                          else out ++ [Invalid] ++ (tokenize' a []) 
  tokenizenum ('-':a) out = out ++ ((\(num,rest) -> [Value (- (read (takeWhile isDigit num)))] ++ (tokenize' rest [])) (break (not.isDigit) a))
  tokenizenum a out = out ++ ((\(num,rest) -> [Value (read (takeWhile isDigit num))] ++ (tokenize' rest [])) (break (not.isDigit) a))

{-
-- dummy tokens ...
tokenize a = myTokenToToken (foldl tokenize' [] a) where 
  tokenValue (Value x) = x
  atoValue c = if c == '-' then -1337 else read [c]
  isValue (Value _) = True
  isValue _ = False
  mysignum x = if x < 0 then -1 else 1 -- sucks to be me
  mytokenlist :: [(Char,MyToken a)]
  mytokenlist = [('-',Minus),('+',MAdd),('*',MMult),('!',MFak),('^',MPot)] ++ (map (\l -> (head (show l),MValue (read (show l)))) [0..9])
  tokenlist :: [(MyToken a,Token a)]
  tokenlist = [(Minus,(Value (-1))),(MAdd,Add),(MMult,Mult),(MFak,Fak),(MPot,Pot)]
  myTokenToToken :: [MyToken a] -> [Token a]
  myTokenToToken = ht' -- map (\l -> maybe ht' id (lookup l tokenlist)) 
  tokenize' :: [MyToken a] -> Char -> [MyToken a]
  tokenize' old l = maybe (tokenizenum old l) (\x -> old ++ [x]) (lookup l mytokenlist)
  tokenizenum old l = if isSpace l then old ++ [Border] else old ++ [MInvalid] 
  ht' s = [ x | (t,s') <- s, x <- t:ht' s' ]
-}
    
{-
  tokenizenum old l =  if isDigit l || l == '-' 
                       then if (old /= [] && isValue (last old))
                            then if (tokenValue (last old)) == -1337 
                                 then (init old) ++ [(Value (-(atoValue l)))]
                                 else (init old) ++ [Value ((atoValue l)*(mysignum (tokenValue (last old)))+10*(tokenValue (last old)))]
                            else old ++ [(Value (atoValue l))] 
                       else if isSpace l then old ++ [Border] else old ++ [MInvalid] 

-}

-- { symb "+"; return (Add) } ++ do { symb "*"; return (Mult) } ++ do { symb "!"; return (Fak) } ++ do { symb "^"; return (Pot) } ++ do { symb "*"; return (Mult) }

-- digit = do { x <- token (sat isDigit); return (ord x - ord '0')}


filter::[Token a]->[Token a]
filter a = Prelude.filter (/= Invalid) a

toString::[Integer]->String
toString [] = "Error"
toString undotted = tail (concat (map ((' ':).show) (reverse undotted)))

interpret::[Token a]->[Integer]
interpret = stackprocess [] where
  stackprocess::[Integer]->[Token a]->[Integer]
  stackprocess a [] = a
  stackprocess (a:[]) (Add:_) = [a]
  stackprocess (a:[]) (Mult:_) = [a]
  stackprocess (a:[]) (Pot:_) = [a]
  stackprocess ([]) (Fak:_) = []
  stackprocess stack (Value a:rest) = stackprocess (a:stack) rest
  stackprocess (n1:n2:stack) (Add:rest) = stackprocess (n1+n2:stack) rest
  stackprocess (n1:n2:stack) (Mult:rest) = stackprocess (n1*n2:stack) rest
  stackprocess (n1:n2:stack) (Pot:rest) = stackprocess (n1^(abs n2):stack) rest
  stackprocess (n:stack) (Fak:rest) = stackprocess (fac n:stack) rest
  stackprocess (a:[]) _ = [a]
  fac n = if n < 0 then -1 else if n == 0 then 1 else n*fac(n-1)