-- $Id: Aufgabe10.hs,v 1.4 2004/01/16 20:57:14 fp010 Exp $
-- module Aufgabe10
module Main(main,inOut,tokenize,
	    Token(Invalid,Mult,Add,Fak,Pot,Value),
	    Main.filter,toString,interpret) 
where
import qualified Prelude
import Prelude hiding(filter)
import qualified Char
import qualified Numeric
----------------------------------------------------------------------------
inOut :: (String->String)->IO Integer

{- batch-version
inOut f = do cont <- getContents
	     let ls = (takeWhile (/="end") . lines) cont
		 in do (putStr . unlines . map f) ls
		       (return . toInteger . length) ls
-}

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

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

----------------------------------------------------------------------------
tokenize :: String -> [Token]
tokenize s = [ x | (t,s') <- read_token s, x <- t:tokenize s' ] 
-- tokenize s = case read_token s of { [] -> []; [(t,s')] -> t:tokenize s' }
  where
    read_token :: ReadS Token
    read_token _s = [ t | s@(_:s') <- [dropWhile Char.isSpace _s],
	 	          let l = reads s, t <- [(Invalid,s')|null l]++l ]

instance Read Token where
    readsPrec _ s
      =	[ (Mult,s')     | ("*",s') <- _lex s ]
      ++[ (Add,s')      | ("+",s') <- _lex s ]
      ++[ (Fak,s')      | ("!",s') <- _lex s ]
      ++[ (Pot,s')      | ("^",s') <- _lex s ]
      ++[(Value (-v),s')| ("-",ds) <- _lex s, (v,s') <- Numeric.readDec ds ]
      ++[ (Value v,s')  | (ds,s')  <- _lex s, (v,"") <- Numeric.readDec ds ]

     where _lex :: ReadS String -- pseudo lex for chars and digits
	   _lex "" = [("","")]
	   _lex s@(c:s') | Char.isSpace c = _lex s'
			 | Char.isDigit c = [span Char.isDigit s]
			 | otherwise      = [([c],s')]

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

----------------------------------------------------------------------------
toString :: [Integer] -> String
toString [] = "Error"
toString l  = unwords . map show . reverse $ l

----------------------------------------------------------------------------
interpret :: [Token] -> [Integer]
interpret = flip eval []
    where fact n = product $ [-1|n<0]++[1..n]
	  a ^ b  = a Prelude.^ abs b
          eval (Value x:toks) st    = eval toks $ x:st
	  eval (Mult:toks) (a:b:st) = eval toks $ a*b:st
	  eval (Add:toks)  (a:b:st) = eval toks $ a+b:st
	  eval (Pot:toks)  (a:b:st) = eval toks $ a^b:st
	  eval (Fak:toks)  (a:st)   = eval toks $ fact a:st
          -- eval (Invalid:toks) _  = undefined
	  eval _ st = st -- no tokens left, Invalid or stack-underflow

----------------------------------------------------------------------------
main :: IO ()
main = do n <- inOut $ toString . interpret . filter . tokenize
	  putStrLn $ show n ++ " Zeilen bearbeitet"

----------------------------------------------------------------------------
-- $Log: Aufgabe10.hs,v $
-- Revision 1.4  2004/01/16 20:57:14  fp010
-- cleaned up parser slightly
--
-- Revision 1.3  2004/01/16 16:53:11  fp010
-- fine-tuning
--
-- Revision 1.2  2004/01/16 08:37:55  fp010
-- fixed subtle bugs in tokenize
--
-- Revision 1.1  2004/01/16 07:25:48  fp010
-- first draft
--