implement !!! operator

This commit is contained in:
sanine 2023-12-27 11:37:24 -06:00
parent a30d5ab293
commit cccd915193
6 changed files with 128 additions and 2 deletions

View file

@ -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`.

View file

@ -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
View 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
View 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
View 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)

View file

@ -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
]