@@ 1,118 @@
+{-# LANGUAGE UnicodeSyntax #-}
+module Uxn.Op
+( Op(..)
+, OpCode(..)
+, OpMeta(..)
+, findOp
+, op
+, opToWord
+, wordToOp
+) where
+
+import Data.Bits ((.&.), (.|.))
+import Data.Function ((&))
+import Data.List (find)
+import Data.Maybe (Maybe, fromJust)
+import Data.Word (Word8)
+import Prelude.Unicode
+
+data Op = Op { opCode ∷ OpCode
+ , opShort ∷ Bool
+ , opRet ∷ Bool
+ , opKeep ∷ Bool
+ }
+ deriving (Eq)
+
+data OpCode =
+ Ibrk | -- stop
+ Ilit | Iinc | Ipop | Idup | Inip | Iswp | Iovr | Irot | -- stack
+ Iequ | Ineq | Igth | Ilth | Ijmp | Ijcn | Ijsr | Isth | -- logic
+ Ildz | Istz | Ildr | Istr | Ilda | Ista | Idei | Ideo | -- memory
+ Iadd | Isub | Imul | Idiv | Iand | Iora | Ieor | Isft -- arithmetic/bitops
+ deriving (Eq)
+
+data OpMeta = OpMeta { mCode ∷ OpCode
+ , mStr ∷ String
+ , mWord ∷ Word8
+ , mDoc ∷ String
+ }
+ deriving (Show)
+
+instance Show Op where
+ show o =
+ (show $ opCode o) ++
+ (if opShort o then "2" else "") ++
+ (if opRet o then "r" else "") ++
+ (if opKeep o then "k" else "")
+
+instance Enum OpCode where
+ toEnum x
+ | (x .&. 0x1f) ≡ 0 = if x ≡ 0 then Ibrk else Ilit
+ | otherwise = mCode $ fromJust $ findOp mWord (fromIntegral x .&. 0x1f)
+ fromEnum x = fromIntegral $ mWord $ fromJust $ findOp mCode x
+
+instance Show OpCode where
+ show x = mStr $ fromJust $ findOp mCode x
+
+findOp ∷ Eq a ⇒ (OpMeta → a) → a → Maybe OpMeta
+findOp f v = find (\o → f o ≡ v) opcodes
+
+op = Op { opCode = Ibrk
+ , opShort = False
+ , opRet = False
+ , opKeep = False
+ }
+
+opToWord ∷ Op → Word8
+opToWord o =
+ fromIntegral (fromEnum $ opCode o) .|.
+ (if opShort o then modeShort else 0) .|.
+ (if opRet o then modeRet else 0) .|.
+ (if opKeep o then modeKeep else 0)
+
+wordToOp ∷ Word8 → Op
+wordToOp w = Op { opCode = toEnum $ fromIntegral (w .&. modeUnmask)
+ , opShort = w .&. modeShort ≠ 0
+ , opRet = w .&. modeRet ≠ 0
+ , opKeep = w .&. modeKeep ≠ 0
+ }
+
+opcodes = [ (Ibrk, "BRK", 0x00, "Halts the program. Further instructions will not be run")
+ , (Ilit, "LIT", modeKeep, "Pushes the next value seen in the program onto the stack")
+ , (Iinc, "INC", 0x01, "Adds 1 to the value at the top of the stack")
+ , (Ipop, "POP", 0x02, "Removes the value at the top of the stack")
+ , (Idup, "DUP", 0x03, "Duplicates the value at the top of the stack")
+ , (Inip, "NIP", 0x04, "Removes the second value from the stack")
+ , (Iswp, "SWP", 0x05, "Exchanges the first and second values at the top of the stack")
+ , (Iovr, "OVR", 0x06, "Duplicates the second value at the top of the stack")
+ , (Irot, "ROT", 0x07, "Rotates three values at the top of the stack, to the left, wrapping around")
+ , (Iequ, "EQU", 0x08, "Pushes 01 to the stack if the two values at the top of the stack are equal, 00 otherwise")
+ , (Ineq, "NEQ", 0x09, "Pushes 01 to the stack if the two values at the top of the stack are not equal, 00 otherwise")
+ , (Igth, "GTH", 0x0a, "Pushes 01 to the stack if the second value at the top of the stack is greater than the value at the top of the stack, 00 otherwise")
+ , (Ilth, "LTH", 0x0b, "Pushes 01 to the stack if the second value at the top of the stack is lesser than the value at the top of the stack, 00 otherwise")
+ , (Ijmp, "JMP", 0x0c, "Moves the program counter by a signed value equal to the byte on the top of the stack, or an absolute address in short mode")
+ , (Ijcn, "JCN", 0x0d, "If the byte preceeding the address is not 00, moves the program counter by a signed value equal to the byte on the top of the stack, or an absolute address in short mode")
+ , (Ijsr, "JSR", 0x0e, "Pushes the value of the program counter to the return-stack and moves the program counter by a signed value equal to the byte on the top of the stack, or an absolute address in short mode")
+ , (Isth, "STH", 0x0f, "Moves the value at the top of the stack, to the return stack")
+ , (Ildz, "LDZ", 0x10, "Pushes the value at an address within the first 256 bytes of memory, to the top of the stack")
+ , (Istz, "STZ", 0x11, "Writes a value to an address within the first 256 bytes of memory")
+ , (Ildr, "LDR", 0x12, "Pushes the value at a relative address, to the top of the stack. The possible relative range is -128 to +127 bytes")
+ , (Istr, "STR", 0x13, "Writes a value to a relative address. The possible relative range is -128 to +127 bytes")
+ , (Ilda, "LDA", 0x14, "Pushes the value at a absolute address, to the top of the stack")
+ , (Ista, "STA", 0x15, "Writes a value to a absolute address")
+ , (Idei, "DEI", 0x16, "FIXME")
+ , (Ideo, "DEO", 0x17, "FIXME")
+ , (Iadd, "ADD", 0x18, "Pushes the sum of the two values at the top of the stack")
+ , (Isub, "SUB", 0x19, "Pushes the difference of the first value minus the second, to the top of the stack")
+ , (Imul, "MUL", 0x1a, "Pushes the product of the first and second values at the top of the stack")
+ , (Idiv, "DIV", 0x1b, "Pushes the quotient of the first value over the second, to the top of the stack")
+ , (Iand, "AND", 0x1c, "Pushes the result of the bitwise operation AND, to the top of the stack")
+ , (Iora, "ORA", 0x1d, "Pushes the result of the bitwise operation OR, to the top of the stack")
+ , (Ieor, "EOR", 0x1e, "Pushes the result of the bitwise operation XOR, to the top of the stack")
+ , (Isft, "SFT", 0x1f, "Moves the bits of the value at the top of the stack to the left or right, depending on the control value of the second. The high nibble of the control value determines how many bits left to shift, and the low nibble how many bits right to shift. The rightward shift is done first")
+ ] & map (\(c, s, w, d) → OpMeta { mCode = c, mStr = s, mWord = w, mDoc = d })
+
+modeUnmask = 0x1f ∷ Word8
+modeShort = 0x20 ∷ Word8
+modeRet = 0x40 ∷ Word8
+modeKeep = 0x80 ∷ Word8
@@ 1,123 @@
+{-# LANGUAGE UnicodeSyntax #-}
+module Uxn.Stmt
+( Stmt
+, opToStmt
+) where
+
+import Uxn.Op
+import Prelude.Unicode
+
+data V = A | B | C
+ deriving (Eq, Show)
+data S = Ws | Rs
+ deriving (Eq, Show)
+data W = W8 | W16
+ deriving (Eq, Show)
+
+data A = Add | Sub | Mul | Div | -- arithmetic
+ Eq | Ne | Lt | Gt | -- comparison
+ Or | And | Eor | Shift -- bit ops
+ deriving (Eq, Show)
+
+data Ref = Memory W Expr
+ | Device W Expr
+ deriving (Eq, Show)
+
+data Expr = Signed Expr
+ | Pop W S
+ | Peep W S
+ | Pull W
+ | Ar A Expr Expr -- right expr evaluated first
+ | Succ Expr
+ | Ref Ref
+ | Var V
+ | PC
+ deriving (Eq, Show)
+
+data Stmt = Push W S [Expr]
+ | Set [(V, Expr)]
+ | Warp W Expr
+ | Poke W Ref Expr
+ | DoIf Expr Stmt
+ | Drop Expr
+ | Break
+ deriving (Eq, Show)
+
+opToStmt ∷ Op → [Stmt]
+opToStmt o =
+ case opCode o of
+ Ibrk → [break]
+ Ilit → [push [pull]]
+ Iinc → [push [succ pop]]
+ Ipop → [drop pop]
+ Idup → [set [(a, pop)], push [a, a]]
+ Inip → [set [(a, pop)], drop pop, push [a]]
+ Iswp → [set [(a, pop), (b, pop)], push [a, b]]
+ Iovr → [set [(a, pop), (b, pop)], push [b, a, b]]
+ Irot → [set [(a, pop), (b, pop), (c, pop)], push [b, a, c]]
+ Iequ → [push8 [pop ≡ pop]]
+ Ineq → [push8 [pop ≠ pop]]
+ Igth → [push8 [pop > pop]]
+ Ilth → [push8 [pop < pop]]
+ Ijmp → [warp pop]
+ Ijcn → [set [(a, pop), (b, pop8)], b ? warp a]
+ Ijsr → [set [(a, pop)], pushd16 [pc], warp a]
+ Isth → [pushd [pop]]
+ Ildz → [push [mem pop8]]
+ Istz → [poke (mem pop8) pop]
+ Ildr → [push [mem $ pc + s8 pop8]]
+ Istr → [poke (mem $ pc + s8 pop8) pop]
+ Ilda → [push [mem pop16]]
+ Ista → [poke (mem pop16) pop]
+ Idei → [push [dev pop8]]
+ Ideo → [poke (dev pop8) pop]
+ Iadd → [push [pop + pop]]
+ Isub → [push [pop - pop]]
+ Imul → [push [pop × pop]]
+ Idiv → [push [pop ÷ pop]]
+ Iand → [push [pop ∧ pop]]
+ Iora → [push [pop ∨ pop]]
+ Ieor → [push [pop ⊕ pop]]
+ Isft → [push [pop ⇔ pop8]]
+ where
+ pop = _pop w src
+ pop8 = _pop W8 src
+ pop16 = _pop W16 src
+ push8 = Push W8 src
+ pushd16 = Push W16 dst
+ pull = Pull w
+ push = Push w src
+ succ = Succ
+ drop = Drop
+ pushd = Push w dst
+ warp = Warp w
+ break = Break
+ (∧) = Ar And
+ (∨) = Ar Or
+ (⊕) = Ar Eor
+ (⇔) = Ar Shift
+ (>) = Ar Gt
+ (<) = Ar Lt
+ (≡) = Ar Eq
+ (≠) = Ar Ne
+ (+) = Ar Add
+ (-) = Ar Sub
+ (×) = Ar Mul
+ (÷) = Ar Div
+ (?) = DoIf
+ s8 = Signed
+ a = Var A
+ b = Var B
+ c = Var C
+ pc = PC
+ poke (Ref r) = Poke w r
+ dev = Ref . Device w
+ mem = Ref . Memory w
+ src = if ret then Rs else Ws
+ dst = if ret then Ws else Rs
+ w = if short then W16 else W8
+ short = opShort o
+ keep = opKeep o
+ ret = opRet o
+ _pop = if keep then Peep else Pop
+ set l = Set (map (\(Var v, e) → (v, e)) l)