implement !!! operator
This commit is contained in:
parent
a30d5ab293
commit
cccd915193
6 changed files with 128 additions and 2 deletions
13
README.md
13
README.md
|
@ -1 +1,14 @@
|
|||
# dclnm
|
||||
|
||||
A haskell-based redcode interpreter. The name is meant to be read as "650 nanometers", DCL being the Roman numeral
|
||||
representation for 650 and 650 nm being the wavelength (λ) of red light.
|
||||
|
||||
It is based on the [ICWS '88 standard](https://corewar.co.uk/standards/icws88.txt).
|
||||
|
||||
## building
|
||||
|
||||
[Stack](https://docs.haskellstack.org/en/stable/) is required to build this project.
|
||||
|
||||
To build the main code, run `stack build`.
|
||||
|
||||
To run the tests, run `stack test`.
|
||||
|
|
|
@ -25,7 +25,9 @@ source-repository head
|
|||
|
||||
library
|
||||
exposed-modules:
|
||||
Dclnm.Memory
|
||||
Lib
|
||||
Types
|
||||
other-modules:
|
||||
Paths_dclnm
|
||||
autogen-modules:
|
||||
|
@ -55,6 +57,7 @@ test-suite dclnm-test
|
|||
type: exitcode-stdio-1.0
|
||||
main-is: Spec.hs
|
||||
other-modules:
|
||||
Dclnm.MemoryTest
|
||||
Paths_dclnm
|
||||
autogen-modules:
|
||||
Paths_dclnm
|
||||
|
|
61
src/Dclnm/Memory.hs
Normal file
61
src/Dclnm/Memory.hs
Normal file
|
@ -0,0 +1,61 @@
|
|||
module Dclnm.Memory
|
||||
( Opcode (..)
|
||||
, Operand (..)
|
||||
, Instruction (..)
|
||||
, op
|
||||
, aField
|
||||
, bField
|
||||
, rawValue
|
||||
, Memory (..)
|
||||
, (!!!)
|
||||
, normalize
|
||||
) where
|
||||
|
||||
data Opcode =
|
||||
Dat
|
||||
| Mov
|
||||
| Add
|
||||
| Sub
|
||||
| Jmp
|
||||
| Jmz
|
||||
| Jmn
|
||||
| Cmp
|
||||
| Slt
|
||||
| Djn
|
||||
| Spl
|
||||
deriving (Eq, Show)
|
||||
|
||||
data Operand =
|
||||
Direct Int
|
||||
| Immediate Int
|
||||
| Indirect Int
|
||||
| Predecrement Int
|
||||
deriving (Eq, Show)
|
||||
|
||||
type Instruction = (Opcode, Operand, Operand)
|
||||
|
||||
-- helper functions for extracting data from instructions
|
||||
op :: Instruction -> Opcode
|
||||
op (o, _, _) = o
|
||||
|
||||
aField :: Instruction -> Operand
|
||||
aField (_, a, _) = a
|
||||
|
||||
bField :: Instruction -> Operand
|
||||
bField (_, _, b) = b
|
||||
|
||||
rawValue :: Operand -> Int
|
||||
rawValue (Direct i) = i
|
||||
rawValue (Immediate i) = i
|
||||
rawValue (Indirect i) = i
|
||||
rawValue (Predecrement i) = i
|
||||
|
||||
newtype Memory = Memory [Instruction]
|
||||
|
||||
(!!!) :: Memory -> Int -> Instruction
|
||||
(!!!) (Memory is) idx = is !! idx'
|
||||
where idx' = idx `mod` (length is)
|
||||
|
||||
|
||||
normalize :: Operand -> Memory -> (Operand, Memory)
|
||||
normalize = undefined
|
9
src/Types.hs
Normal file
9
src/Types.hs
Normal file
|
@ -0,0 +1,9 @@
|
|||
module Types where
|
||||
|
||||
|
||||
data Opcode = Dat | Mov | Add | Sub | Jmp | Jmz | Jmn | Cmp | Slt | Djn | Spl deriving (Eq, Show, Enum)
|
||||
data Operand = Direct Int | Immediate Int | Indirect Int | Predec Int deriving (Eq, Show)
|
||||
type Instruction = (Opcode, Operand, Operand)
|
||||
type Memory = [Instruction]
|
||||
type Process = [Int]
|
||||
type Machine = (Memory, [Process])
|
37
test/Dclnm/MemoryTest.hs
Normal file
37
test/Dclnm/MemoryTest.hs
Normal file
|
@ -0,0 +1,37 @@
|
|||
module Dclnm.MemoryTest (suite) where
|
||||
|
||||
import Test.Tasty
|
||||
import Test.Tasty.HUnit
|
||||
|
||||
import Dclnm.Memory
|
||||
|
||||
|
||||
suite :: TestTree
|
||||
suite = testGroup "Dclnm.Memory" $
|
||||
[ circleMem
|
||||
]
|
||||
|
||||
|
||||
-- circular memory buffer
|
||||
circleMem :: TestTree
|
||||
circleMem = testCase "memory buffers are circular" $
|
||||
let
|
||||
buf = Memory
|
||||
[ (Dat, Direct 0, Direct 3)
|
||||
, (Dat, Direct 1, Direct 2)
|
||||
, (Dat, Direct 2, Direct 1)
|
||||
, (Dat, Direct 3, Direct 0)
|
||||
]
|
||||
in do
|
||||
(buf !!! 0) @?= (Dat, Direct 0, Direct 3)
|
||||
(buf !!! 1) @?= (Dat, Direct 1, Direct 2)
|
||||
(buf !!! 2) @?= (Dat, Direct 2, Direct 1)
|
||||
(buf !!! 3) @?= (Dat, Direct 3, Direct 0)
|
||||
(buf !!! 4) @?= (Dat, Direct 0, Direct 3)
|
||||
(buf !!! 5) @?= (Dat, Direct 1, Direct 2)
|
||||
(buf !!! 6) @?= (Dat, Direct 2, Direct 1)
|
||||
(buf !!! 7) @?= (Dat, Direct 3, Direct 0)
|
||||
(buf !!! 8) @?= (Dat, Direct 0, Direct 3)
|
||||
(buf !!! 9) @?= (Dat, Direct 1, Direct 2)
|
||||
(buf !!! 10) @?= (Dat, Direct 2, Direct 1)
|
||||
(buf !!! 11) @?= (Dat, Direct 3, Direct 0)
|
|
@ -1,7 +1,10 @@
|
|||
|
||||
import Test.Tasty
|
||||
import Test.Tasty.HUnit
|
||||
|
||||
import qualified Dclnm.MemoryTest (suite)
|
||||
|
||||
|
||||
main :: IO ()
|
||||
main = defaultMain $ testCase "test" $ 4 @?= 3
|
||||
main = defaultMain $ testGroup "all tests" $
|
||||
[ Dclnm.MemoryTest.suite
|
||||
]
|
||||
|
|
Loading…
Reference in a new issue