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)