blob: 59b9402a09e8249014b7ccc566b6cc66b4921200 (
plain)
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
|
{-# LANGUAGE BangPatterns #-}
module Interpreter(interpret) where
import qualified Data.Vector.Mutable as MV
import AST
type Tape = MV.IOVector Byte
interpret :: Program -> [Byte] -> IO [Byte]
interpret (Program inss) inp = MV.replicate 60000 0 >>= \tape -> interInss 0 tape 30000 inss inp
interInss :: Int -> Tape -> Int -> [Instruction] -> [Byte] -> IO [Byte]
interInss _ _ _ [] _ = return []
-- interInss count _ _ _ _ | count > 2000000000 = return []
interInss !count !tape !memp allinss@(ins:rest) inp = case ins of
(IAdd value offset) -> do
MV.modify tape (+ value) (memp + offset)
interInss (count + 1) tape memp rest inp
(ISet value offset) -> do
MV.write tape (memp + offset) value
interInss (count + 1) tape memp rest inp
(IMove from tos) -> do
value <- MV.read tape (memp + from)
MV.write tape (memp + from) 0
mapM_ (\(offset, multiplier) -> MV.modify tape ((+) (multiplier * value)) (memp + offset)) tos
interInss (count + 1) tape memp rest inp
(ISlide offset) -> do
interInss (count + 1) tape (memp + offset) rest inp
(ILoop iins offset) -> do
value <- MV.read tape (memp + offset)
if value /= 0
then interInss (count + 1) tape memp (iins ++ allinss) inp
else interInss (count + 1) tape memp rest inp
(IInput offset) -> do
let (c:cs) = inp
MV.write tape (memp + offset) c
interInss (count + 1) tape memp rest cs
(IOutput offset) -> do
value <- MV.read tape (memp + offset)
(value :) <$> interInss (count + 1) tape memp rest inp
IStart -> do
interInss (count + 1) tape memp rest inp
|
