你懂得……扯上IO就会很麻烦…………

lcsIO.hs

import Data.Array
import Data.Array.IO
import Data.Ix

lcs :: String -> String -> Int
lcs s t = a!(n,m)
  where a = array ((0,0),(n,m)) [((x,y), f x y)|x<-[0..n],y<-[0..m]]
        n = length s
        m = length t
        s'= array (0,n-1) $ zip [0..n-1] s
        t'= array (0,m-1) $ zip [0..m-1] t
        f :: Int->Int->Int
        f i j
          | min i j == 0        = 0
          | s'!(i-1)==t'!(j-1)  = a!(i-1,j-1) +1
          | otherwise           = max (a!(i-1,j)) (a!(i,j-1))

type TheArraysYouKnow = ( 
    IOUArray (Int,Int) Int ,   -- main table
    IOUArray Int Char,         -- s
    IOUArray Int Char          -- t
    )

lcsIO :: String -> String -> IO Int
lcsIO s t = do  
  let n = length s
      m = length t
  theArrayYouKnow <- newListArray ((0,0),(n,m)) (repeat 0) 
  theSArray <- newListArray (0,n-1) s
  theTArray <- newListArray (0,m-1) t
  mapM_ (theFunctionYouKnow (theArrayYouKnow , theSArray ,theTArray ))$ range ((0,0),(n,m))
  readArray theArrayYouKnow (n,m)  
  where
    theFunctionYouKnow ::TheArraysYouKnow -> (Int,Int) -> IO ()
    theFunctionYouKnow (a,s,t) (i,j) 
      | min i j == 0  = writeArray a (i,j) 0
      | otherwise     = do
          sChar <- readArray s (i-1)
          tChar <- readArray t (j-1)
          if (sChar == tChar ) then do
            lookback <- readArray a (i-1,j-1)
            writeArray a (i,j) (lookback + 1)
          else do
            left <- readArray a (i-1,j)
            right <- readArray a (i,j-1)
            writeArray a (i,j) (max left right)