1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.

module Main where

import qualified Control.Exception as CE
import Data.Char
import Data.Word
import System.Environment
import System.IO
import Text.ParserCombinators.Parsec
import Debug.Trace

type Program = [Operator]
data Operator = Add
| Minus
| Next
| Previous
| Loop Program
| Input
| Output

type Index  = Int
type Memory = [Int]
data ProgramState  = ProgramState Memory Index deriving Show

--transform :: IO ProgramState->ProgramState
--transform (ProgramState mem ind) = (ProgramState mem ind)

johnSmith :: Program
johnSmith  = [Input, Next, Input, Loop [Minus, Previous, Add, Next], Previous, Output]

exec :: Program->ProgramState->IO ProgramState
--exec p st = foldM run p st
exec [] st = return st
exec (x:xs) st = do
newSt <- run x st
exec xs newSt

run  :: Operator->ProgramState->IO ProgramState
run op st=
case op of
Add       -> return $! myAdd st
Minus     -> return $! minus st
Next      -> return $! next st
Previous  -> return $! prev st
Loop p    -> loop p st
Input     -> getIn st
Output    -> printOut st

myAdd     :: ProgramState->ProgramState
addHelper :: Int->Int->Memory->Memory
myAdd (ProgramState mem ind) = (ProgramState (addHelper 0 ind mem) ind)
addHelper n ind (x:xs)| n==ind  = [x+1] ++ xs
| n/=ind  = [x]   ++ (addHelper (n+1) ind xs)
addHelper n ind []    | n==ind  = [1]
| n/=ind  = [0]   ++ (addHelper (n+1) ind [])

minus       :: ProgramState->ProgramState
minusHelper :: Int->Int->Memory->Memory
minus (ProgramState mem ind)   = (ProgramState (minusHelper 0 ind mem) ind)
minusHelper n ind (x:xs)| n==ind  = [x-1] ++ xs
| n/=ind  = [x]   ++ (minusHelper (n+1) ind xs)
minusHelper n ind []    | n==ind  = [-1]
| n/=ind  = [0]   ++ (minusHelper (n+1) ind [])

next :: ProgramState->ProgramState
next (ProgramState mem ind) = (ProgramState mem (ind+1))

prev :: ProgramState->ProgramState
prev (ProgramState mem 0)   = error "Pointer fell off back of data"
prev (ProgramState mem ind) = (ProgramState mem (ind-1))

loop :: Program->ProgramState->IO ProgramState
loop p st=
if isZero st
then return st
else do
newSt <- exec p st
loop p newSt

isZero     :: ProgramState->Bool
zeroHelper :: Int->Int->Memory->Bool
isZero (ProgramState mem ind) = zeroHelper 0 ind mem
zeroHelper n ind []    = True
zeroHelper n ind (x:xs)| n==ind = testInt x
| n/=ind = zeroHelper (n+1) ind xs
testInt :: Int->Bool
testInt 0  = True
testInt n  = False

myMem   = [0]
myInd   = 0
myProgramState = (ProgramState myMem myInd)

getIn    :: ProgramState->IO ProgramState
inHelper :: Int->Int->Memory->Int->Memory
getIn (ProgramState mem ind) = do line <- getLine
return (ProgramState (inHelper 0 ind mem (read line :: Int)) ind)
inHelper n ind (x:xs) s| n==ind  = [s] ++ xs
| n/=ind  = [x] ++ (inHelper (n+1) ind xs s)
inHelper n ind []     s| n==ind  = [s]
| n/=ind  = [0] ++ (inHelper (n+1) ind [] s)

printOut  :: ProgramState->IO ProgramState
outHelper :: Int->Int->Memory->IO Memory
printOut (ProgramState mem ind) = do outHelper 0 ind mem
return (ProgramState mem ind)

outHelper n ind (x:xs)| n==ind  = do print x
return ([x] ++ xs)
| n/=ind  = do rest <- outHelper (n+1) ind xs
return ([x] ++ rest)
outHelper n ind []              = do print 0
return []



pParser :: Parser Program
pParser = many iParser

iParser :: Parser Operator
iParser = simple <|> lParser

lParser :: Parser Operator
lParser = between (char '[') (char ']') pParser >>= p -> return $ Loop p

simple :: Parser Operator
simple =     ((char '+') >>= _ -> return $ Add )
<|> ((char '-') >>= _ -> return $ Minus)
<|> ((char '>') >>= _ -> return $ Next)
<|> ((char '<') >>= _ -> return $ Previous)
<|> ((char '.') >>= _ -> return $ Output)
<|> ((char ',') >>= _ -> return $ Input)

main = do args <- getArgs
if length args < 1
then fail "Please provide name of the program to run"
else do prog <- readFile (head args)
case (parse pParser "" . normalize) prog of
Left err    -> do putStr "Parse error at "
print err
Right res   -> do exec res (ProgramState [0] 0)
return ()
normalize :: String -> String
normalize program = filter (`elem` "+-<>[].,") program