Eighth

Automaton2.hs

module Automaton2 where

data StateI ident = StateA ident TransitionsA Bool
 deriving Show

type StateA = StateI Ident

type Ident = String

type TransitionsA = Map.Map Char StateA
-- [('a', state1), ('b', state2), ('c', state3) ...., ('z', state26)]

transitions :: [StateA] -> TransitionsA
-- transitions []     = []
-- transitions [x]    = [('a',x)]
transitions xs = Map.fromList $ zip ['a'..'z'] xs
-- fromList :: [(a,b)] -> Map a b

acceptsA :: StateA -> String -> Bool
acceptsA (StateA _ _ finalFlag) "" = finalFlag
acceptsA (StateA _ ts _       ) (c:cs) =
  -- lookup :: Eq a => a -> [(a,b)] -> Maybe b
  case Map.lookup c ts of
       Nothing       -> False
       Just newState -> newState `acceptsA` cs

-- Gebe die Folge der durchlaufenden Zustände aus, wenn
--  das Wort vom Automaten erkannt wird, sonst `Nothing`
acceptSeq :: StateA -> String -> Maybe [Ident]
acceptSeq (StateA ident _  finalTag) ""     | finalTag  = Just [ident]
                                            | otherwise = Nothing
acceptSeq (StateA ident ts _       ) (c:cs) =
  case Map.lookup c ts of
       Nothing       -> Nothing
       Just newState -> case acceptSeq newState cs of
          Nothing -> Nothing
          Just qs -> Just (ident:qs)

-- Zustände sollen vergleichbar sein
instance Eq ident => Eq (StateI ident) where
  (==) (StateA i _ _) (StateA i' _ _) = i == i'

baa' :: StateA
baa' = q0
 where
  q0 = StateA "q0" (transitions [q0,q1]) False
  q1 = StateA "q1" (transitions [q2,q1]) False
  q2 = StateA "q2" (transitions [q3,q1]) False
  q3 = StateA "q3" (transitions [q3,q3]) True


-- Wiederholung zu list comprehensions
square :: [Int] -> [Int]
square xs = [ x*x | x <- xs]

-- 'boom' fuer gerade Zahlen, 'bang' fuer ungerade Zahlen
boomBang :: [Int] -> [String]
boomBang xs = [ y | x <- xs
                  , y <- ["Boom","Bang"], y == "Boom" && x `mod` 2 == 0
                                       || y == "Bang" && x `mod` 2 == 1]
length' :: [Int] -> Int
length' xs = sum [ 1 | _ <- xs]

-- Eine kurze Wiederholung von IO und do-Notation
main :: IO Int
main = do
  putStrLn "Hallo"
  -- x :: String
  x <- getLine :: IO String
  return $ read x :: IO Int

-- Read a => read :: String -> a
-- return :: a -> IO a