我试图在Haskell中实现词法分析器。为了便于控制台输入和输出，我使用了中间数据类型转换表。
type TransitionTable = [(Int, Transitions String Int)]
type Transitions a b = [(a, b)]
我想从用户那里获取所有状态和转换的输入。我不想事先拿出总状态数。我希望它继续为每个状态的转换输入输入，直到用户键入＆＃34; - ＆＃34; 。如果用户键入＆＃34; ---＆＃34; ，则会丢弃当前状态并终止输入。
经过多次尝试，我想出了这个，我认为这是一个可怕的代码。
-- |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)
基本上这就是它的运行方式：
*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
有更好的方法吗？
答案 0 :(得分：1)
正如其他人所建议的那样，对于与解析相关的任务，您应该查看Parsec。虽然我没有使用它的经验，但我仍然可以建议另一种编写解析应用程序的方法。
module Main where
import Control.Monad (liftM)
computeTransitions :: [String] -> [(Int, [(String, Int)])]
computeTransitions is = foldl folder [] is
where
getState states = if null states then (0, []) else last states
getTransition transitions = if null transitions then 0 else (snd $ head transitions)
prepend state transition = let (c, ts) = state in (c, transition:ts)
swapLastState states state = if null states then [state] else init states ++ [state]
folder states i =
let currentState = getState states
currentTransition = getTransition (snd currentState)
in case i == "--" of False -> swapLastState states (prepend currentState (i, currentTransition + 1))
True -> states ++ [((fst currentState) + 1, [])]
main = do
inputLines <- liftM (takeWhile (/="---")) (liftM lines getContents)
let result = computeTransitions inputLines
mapM_ (\(s, t) -> putStrLn $ show s ++ "\t" ++ show t) result
我不知道你的要求是否打印出中间消息，但转换的计算可以转换为折叠操作（如果你想打印中间消息，则转换为foldM）;而不是“while”循环，我使用takeWhile函数提升到Monadic空间（所以我可以将它应用于类型IO [String]）。
另请注意，getContents在评估中是懒惰的，并且与lines结合使用时将作为“同时读取行”。
修改
根据@pat的建议（以及hlint提出的内容），这里是重构版本：
module Main where
import Control.Monad (liftM)
computeTransitions :: [String] -> [(Int, [(String, Int)])]
computeTransitions = foldl folder []
where
getState [] = (0, [])
getState states = last states
getTransition [] = 0
getTransition ((_, t):_) = t
prepend (c,ts) transition = (c, transition:ts)
swapLastState [] state = [state]
swapLastState states state = init states ++ [state]
folder states i =
let currentState = getState states
currentTransition = getTransition (snd currentState)
in if i == "--"
then states ++ [(fst currentState + 1, [])]
else swapLastState states (prepend currentState (i, currentTransition + 1))
main = do
inputLines <- liftM (takeWhile (/="---") . lines) getContents
mapM_ (\(s, t) -> putStrLn $ show s ++ "\t" ++ show t) (computeTransitions inputLines)
答案 1 :(得分：1)
如果你添加“派生阅读”声明并且不关心交互，可能就是这么简单。
main = do
allInput <- getContents -- scarfs all stdin up to eof
let inLines = lines allInput
let (tableLines, _:otherlines) = break (== "endtable") inLines
let table = ((read $ unlines tableLines) :: TransitionTable)
-- process otherlines here