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

---
 ast.hs | 70 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 70 insertions(+)
 create mode 100644 ast.hs

(limited to 'ast.hs')

diff --git a/ast.hs b/ast.hs
new file mode 100644
index 0000000..9a4373d
--- /dev/null
+++ b/ast.hs
@@ -0,0 +1,70 @@
+module AST where
+
+import Data.List
+import Data.Word
+
+
+type Byte = Word8
+type Offset = Int
+
+
+newtype Program = Program [Instruction]
+  deriving (Show, Eq)
+
+data Instruction
+    = IAdd Byte Offset
+    | ISet Byte Offset
+    | IMove Offset [(Offset, Byte)]  -- IMove from [(to, multiplier)]
+    | ISlide Offset
+    | ILoop [Instruction] Offset
+    | IInput Offset
+    | IOutput Offset
+    | IStart
+  deriving (Show, Eq)
+
+isIAdd :: Instruction -> Bool
+isIAdd (IAdd _ _) = True
+isIAdd _ = False
+
+isISet :: Instruction -> Bool
+isISet (ISet _ _) = True
+isISet _ = False
+
+isIMove :: Instruction -> Bool
+isIMove (IMove _ _) = True
+isIMove _ = False
+
+isISlide :: Instruction -> Bool
+isISlide (ISlide _) = True
+isISlide _ = False
+
+offsetOf :: Instruction -> Offset
+offsetOf (IAdd _ o) = o
+offsetOf (ISet _ o) = o
+offsetOf (IMove o _) = o
+offsetOf (ISlide _) = undefined
+offsetOf (ILoop _ _) = undefined
+offsetOf (IInput o) = o
+offsetOf (IOutput o) = o
+offsetOf IStart = 0
+
+astSuccinct :: Program -> String
+astSuccinct (Program inss) = concatMap insSuccinct inss
+  where
+    insSuccinct :: Instruction -> String
+    insSuccinct (IAdd v o) =
+        let sv = signedByte v
+        in (if sv >= 0 then "+" else "") ++ show (signedByte v) ++ ',' : show o
+    insSuccinct (ISet v o) = '=' : show (signedByte v) ++ ',' : show o
+    insSuccinct (IMove from tos) =
+        'M' : show from ++ '(' : intercalate "," (map (\(o,m) -> show o ++ '*' : show m) tos) ++ ")"
+    insSuccinct (ISlide o) = '>' : show o
+    insSuccinct (ILoop inss' off) = "[(" ++ show off ++ ')' : concatMap insSuccinct inss' ++ "]"
+    insSuccinct (IInput o) = ',' : show o
+    insSuccinct (IOutput o) = '.' : show o
+    insSuccinct IStart = "$"
+
+    signedByte :: Byte -> Int
+    signedByte v
+        | v < 128 = fromIntegral v
+        | otherwise = fromIntegral v - 256
-- 
cgit v1.2.3-54-g00ecf