W Twoim przypadku jest to problem z ograniczeniem, który powoduje przepełnienie stosu. Jednym z łatwych sposobów na znalezienie takich problemów jest użycie deepseq library. To dodaje kilka funkcji, które pozwalają w pełni ocenić wartość (która jest lepsza niż seq, która idzie tylko o jeden poziom w dół). Kluczową funkcją jest force :: NFData a => a -> a. To bierze wartość, w pełni ją ocenia i zwraca.
Działa to tylko dla typów, które implementują klasę typu NFData. Na szczęście istnieje makro szablonu haskell w deepseq-th library: deriveNFData. Jest używany z własnymi typami danych, np. deriveNFData ''BfMachine.
Aby użyć, należy umieścić force $ przed swoimi funkcjami, które mogą mieć problemy ze ścisłością (lub liftM force $ dla funkcji monadycznych).Na przykład z kodem, kładę go przed step, ponieważ był funkcyjny w pliku:
{-# LANGUAGE TemplateHaskell #-}
import Data.Char
import Debug.Trace
import Control.DeepSeq
import Control.DeepSeq.TH
import Control.Monad (liftM)
type Stack = [Int]
data BfMachine = BfMachine
{ program :: String
, pc :: Int
, stack :: Stack
, sp :: Int
} deriving Show
deriveNFData ''BfMachine
setElem :: [Int] -> Int -> Int -> [Int]
setElem list n value = map (\(i, v) -> if i == n then value else v) (zip [0..] list)
step :: BfMachine -> IO (BfMachine)
step [email protected](BfMachine { program = program, pc = pc, stack = stack, sp = sp }) = liftM force $
case program !! pc of
'-' -> return m { pc = pc + 1, stack = setElem stack sp ((stack !! sp) - 1) }
'+' -> return m { pc = pc + 1, stack = setElem stack sp ((stack !! sp) + 1) }
'<' -> return m { pc = pc + 1, sp = sp - 1 }
'>' -> return m { pc = pc + 1, sp = sp + 1 }
'[' -> return $ if stack !! sp /= 0 then m { pc = pc + 1 }
else m { pc = (findNextBracket program $ pc + 1) + 1 }
']' -> return m { pc = findPrevBracket program $ pc - 1 }
'.' -> do putChar $ chr $ stack !! sp
return m { pc = pc + 1 }
',' -> do c <- getChar
let s' = setElem stack sp $ ord c
in return m { stack = s', pc = pc + 1 }
a -> return m { pc = pc + 1 }
findNextBracket :: String -> Int -> Int
findNextBracket program pos =
case program !! pos of
'[' -> findNextBracket program $ (findNextBracket program $ pos + 1) + 1
']' -> pos
x -> findNextBracket program (pos + 1)
findPrevBracket :: String -> Int -> Int
findPrevBracket program pos =
case program !! pos of
']' -> findPrevBracket program $ (findPrevBracket program $ pos - 1) - 1
'[' -> pos
x -> findPrevBracket program (pos - 1)
isFinished :: BfMachine -> Bool
isFinished [email protected](BfMachine { program = p, pc = pc })
| pc == length p = True
| otherwise = False
run :: BfMachine -> IO()
run m = do
if isFinished m then
return()
else do
m <- step m
run m
fib = ">++++++++++>+>+[ [+++++[>++++++++<-]>.<++++++[>--------<-]+<<<]>.>>[ [-]<[>+<-]>>[<<+>+>-]<[>+<-[>+<-[>+<-[>+<-[>+<-[>+<- [>+<-[>+<-[>+<-[>[-]>+>+<<<-[>+<-]]]]]]]]]]]+>>> ]<<< ] This program doesn't terminate; you will have to kill it. Daniel B Cristofani (cristofdathevanetdotcom) http://www.hevanet.com/cristofd/brainfuck/"
main = run BfMachine { program = fib , pc = 0, stack = replicate 1024 0, sp = 0 }
To rzeczywiście rozwiązuje problem - nawet po kilku minutach jazdy, nie rozbił się i pamięć wykorzystanie wynosi tylko 3,2 MB.
Możesz trzymać się tego rozwiązania lub próbować znaleźć prawdziwy problem związany ze ścisłością (co czyni wszystko ścisłym). Robi się to przez usunięcie siły z funkcji step i wypróbowanie jej na funkcjach pomocniczych, których używa (np. setElem, findPrevBacket itd.). Okazuje się, że winowajcą jest setElem, dzięki czemu przed tą funkcją rozwiązuje się również problem ze ścisłością. Zgaduję, że to dlatego, że if w lambda mapy oznacza, że większość wartości nigdy nie musi być oceniana na liście, i prawdopodobnie budować ogromne tony podczas trwania programu.
jak skompilowałeś? ghc -O2 blah.hs może być w stanie zoptymalizować lepiej –
Dzięki, ale to nie pomogło – Philippe
czy mógłbyś podać link do pastebin do kodu? – jev