From d015d797fe8d152864cdd5f1ce284bd5ff467f9e Mon Sep 17 00:00:00 2001
From: tomsmeding <tom.smeding@gmail.com>
Date: Thu, 13 Jul 2017 23:24:04 +0200
Subject: Initial

---
 interpreter.hs | 46 ++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 46 insertions(+)
 create mode 100644 interpreter.hs

(limited to 'interpreter.hs')

diff --git a/interpreter.hs b/interpreter.hs
new file mode 100644
index 0000000..59b9402
--- /dev/null
+++ b/interpreter.hs
@@ -0,0 +1,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
-- 
cgit v1.2.3-54-g00ecf