summaryrefslogtreecommitdiff
path: root/interpreter.hs
diff options
context:
space:
mode:
authorTom Smeding <tom.smeding@gmail.com>2018-04-15 00:12:01 +0200
committerTom Smeding <tom.smeding@gmail.com>2018-04-15 00:12:01 +0200
commit873c294497c74e85eae5310cbf19269807c75e6d (patch)
treebc8558a62559b449ff702593cdc40314359ae2db /interpreter.hs
parent6489f93d146d7b6a381fc2815158240d26b5febc (diff)
Build with stack
Diffstat (limited to 'interpreter.hs')
-rw-r--r--interpreter.hs45
1 files changed, 0 insertions, 45 deletions
diff --git a/interpreter.hs b/interpreter.hs
deleted file mode 100644
index 4f3f3aa..0000000
--- a/interpreter.hs
+++ /dev/null
@@ -1,45 +0,0 @@
-{-# 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
- (ICopy from to mult) -> do
- value <- MV.read tape (memp + from)
- MV.modify tape ((+) (mult * value)) (memp + to)
- 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