I'm trying to implement a lexer in Haskell. For easy console input and output, I've used an intermediate data type Transition Table.
type TransitionTable = [(Int, Transitions String Int)] type Transitions a b = [(a, b)]
I want to take input from the user for all the states and transitions. I do not want to take the total number of states before hand. I want it to keep taking input for the transitions of each state until the user types "--" . If the user types "---", the current state is discarded and the input terminates.
After a lot of attempts I came up with this, which I think is horrible code.
-- |A function to emulate the while loop for easy IO functionality. -- Defination:- while @comparator @func @start: -- *comparator @arg: A function which returns True or False on the basis of @arg. -- The loop stops when False is returned. -- *func: The function which is executed repeadly. -- It is responsible for returning the next @arg for the comparator on the basis of the current @arg. -- *start: The starting value of @arg to pass to the comparator. while :: (Monad m) => (a -> Bool) -> (a -> m a) -> a -> m a while comparator func start = if comparator start then do nxt <- func start while comparator func nxt else return start -- |A modification of putStr which flushes out stdout. Corrents buffer problems. myPutStr :: String -> IO () myPutStr str = putStr str >> hFlush stdout >> return ()
-- Takes input from the console to generate a TransitionTable. inputTransitionTable :: IO TransitionTable inputTransitionTable = do putStrLn "Type -- for next state and --- for completing input entering." retVal <- while notFinished takeInfo (0, ) return (snd retVal) where -- Returns True when input entry is over. notFinished (i, _) = i > -1 -- Takes the current state number and the incomplete corrosponding transition table which is populated -- with user input. Input ends when user enters "---". State number is set to -1 when input is over. takeInfo (i, states) = do putStrLn ("Adding transitions to state " ++ show i ++ ": ") retVal <- while entryNotFinished takeStateInfo ("", ) let (inpStr, stateInfo) = retVal case inpStr == "---" of True -> return (-1, states) False -> return (i+1, states ++ [(i, stateInfo)]) -- Checks if input entry is over. Returns False if finished. entryNotFinished (s, _) | s == "--" || s == "---" = False | otherwise = True -- Takes the input state number along with the corresponding transitions. -- Input ends when the user enters "--". takeStateInfo (str, state_info) = do myPutStr "\tEnter transitions symbol: " symbol <- getLine if symbol == "--" || symbol == "---" then return (symbol, state_info) else do myPutStr "\t\tEnter the transition state number: " state' <- getLine let state = read state' :: Int return (str, (symbol, state):state_info)
Basically this is how it runs:
*Main> x <- inputTransitionTable Type -- for next state and --- for completing input entering. Adding transitions to state 0: Enter transitions symbol: a Enter the transition state number: 1 Enter transitions symbol: b Enter the transition state number: 2 Enter transitions symbol: -- Adding transitions to state 1: Enter transitions symbol: a Enter the transition state number: 2 Enter transitions symbol: b Enter the transition state number: 3 Enter transitions symbol: -- Adding transitions to state 2: Enter transitions symbol: a Enter the transition state number: 3 Enter transitions symbol: -- Adding transitions to state 3: Enter transitions symbol: -- Adding transitions to state 4: Enter transitions symbol: --- (0.03 secs, 344420 bytes) -- Output *Main> prettyPrintTransitionTable x State Transitions 0 ("b",2) ("a",1) 1 ("b",3) ("a",2) 2 ("a",3) 3
Is there a better way to do this?