diff --git a/src/Instructions/CodeInstructions.hs b/src/Instructions/CodeInstructions.hs
index 363673c..39395dc 100644
--- a/src/Instructions/CodeInstructions.hs
+++ b/src/Instructions/CodeInstructions.hs
@@ -4,6 +4,8 @@ import State
import Instructions.GenericInstructions
import Instructions.IntInstructions
+-- import Debug.Trace
+
isBlock :: Gene -> Bool
isBlock (Block _) = True
isBlock _ = False
@@ -38,6 +40,15 @@ extractTailFromBlock :: Gene -> Gene
extractTailFromBlock (Block xs) = Block (drop 1 xs)
extractTailFromBlock gene = gene
+-- This function took at least 3 hours to program.
+codeAtPoint :: [Gene] -> Int -> Gene
+codeAtPoint (gene : _) 0 = gene
+codeAtPoint [] _ = Block [] -- Should only happen if an empty block is last Gene in the list of Genes
+codeAtPoint ((Block nestedGenes) : genes) index = codeAtPoint (nestedGenes <> genes) (index - 1)
+codeAtPoint (_ : genes) index = codeAtPoint genes (index - 1)
+
+-- This one functions differently than pysh.
+-- I like this one because it preserves ordering
codeCombine :: Gene -> Gene -> Gene
codeCombine (Block xs) (Block ys) = Block (xs <> ys)
codeCombine (Block xs) ygene = Block (xs <> [ygene])
@@ -49,6 +60,11 @@ codeMember (Block _) (Block _) = False -- Can't compare two lists with `elem`
codeMember (Block xs) ygene = ygene `elem` xs
codeMember _ _ = False
+-- I love list comprehensions
+codeRecursiveSize :: Gene -> Int
+codeRecursiveSize (Block xs) = sum [codeRecursiveSize x + if isBlock x then 1 else 0 | x <- xs]
+codeRecursiveSize _ = 1
+
instructionCodePop :: State -> State
instructionCodePop state = instructionPop state code
@@ -150,13 +166,40 @@ instructionCodeMember :: State -> State
instructionCodeMember state@(State {_code = (c1 : c2 : cs), _bool = bs}) = state{_code = cs, _bool = codeMember c1 c2 : bs}
instructionCodeMember state = state
+-- This one doesn't count the recursive Blocks while instructionCodeExtract does
-- https://erp12.github.io/pyshgp/html/core_instructions.html#code-nth
instructionCodeN :: State -> State
-instructionCodeN state@(State {_code = (c1 : cs), _int = (_ : is)}) =
- if not $ blockIsNull c1Block
- then state {_code = c1Block : cs, _int = is}
+instructionCodeN state@(State {_code = ((Block c1) : cs), _int = (i1 : is)}) =
+ if not $ null c1
+ then state {_code = c1 !! index : cs, _int = is}
else state
where
- c1Block :: Gene
- c1Block = if not $ isBlock c1 then Block [c1] else c1
+ index :: Int
+ index = abs i1 `mod` length c1
+instructionCodeN state@(State {_code = (c1 : cs), _int = _ : is}) = state {_code = c1 : cs, _int = is}
instructionCodeN state = state
+
+instructionMakeEmptyCodeBlock :: State -> State
+instructionMakeEmptyCodeBlock state@(State {_code = cs}) = state {_code = Block [] : cs}
+
+instructionIsEmptyCodeBlock :: State -> State
+instructionIsEmptyCodeBlock state@(State {_code = Block c1 : cs, _bool = bs}) = state{_code = cs, _bool = null c1 : bs}
+instructionIsEmptyCodeBlock state@(State {_bool = bs}) = state{_bool = False : bs}
+
+instructionCodeSize :: State -> State
+instructionCodeSize state@(State {_code = c1 : cs, _int = is}) = state{_code = cs, _int = codeRecursiveSize c1 : is}
+instructionCodeSize state = state
+
+-- There's a bug for this instruction in pysh where the last item in the
+-- top level Block isn't counted, and if passed 0, then the entire codeblock is returned.
+-- I designed this function differently so 0 returns the 0th element, and the last item
+-- in the codeblock can be returned.
+instructionCodeExtract :: State -> State
+instructionCodeExtract state@(State {_code = (block@(Block c1) : cs), _int = i1 : is}) =
+ let
+ index = abs i1 `mod` codeRecursiveSize block
+ in
+ state{_code = codeAtPoint c1 index : cs, _int = is}
+
+instructionCodeExtract state@(State {_code = cs, _int = _ : is}) = state{_code = cs, _int = is}
+instructionCodeExtract state = state
diff --git a/test/Main.hs b/test/Main.hs
index 79026f3..20a8736 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -1,8 +1,8 @@
import Control.Exception (assert)
+import Instructions.CodeInstructions
import Instructions.ExecInstructions
import Instructions.FloatInstructions
import Instructions.IntInstructions
-import Instructions.CodeInstructions
import Push
import State
@@ -28,7 +28,7 @@ boolTestFunc name goal genome startState =
codeTestFunc :: String -> [Gene] -> [Gene] -> State -> IO ()
codeTestFunc name goal genome startState =
let state = loadProgram genome startState
- in assert (goal == _code (interpretExec state)) putStrLn (name <> " passed test.")
+ in assert (goal == _code (interpretExec state)) putStrLn (name <> " passed test.")
main :: IO ()
main = do
@@ -107,7 +107,16 @@ main = do
intTestFunc "instructionCodeIfTrue" [6] [GeneBool True, StateFunc instructionCodeFromExec, GeneInt 3, StateFunc instructionCodeFromExec, GeneInt 6, StateFunc instructionCodeIf] emptyState
intTestFunc "instructionCodeIfFalse" [3] [GeneBool False, StateFunc instructionCodeFromExec, GeneInt 3, StateFunc instructionCodeFromExec, GeneInt 6, StateFunc instructionCodeIf] emptyState
intTestFunc "instructionCodeWhen" [6, 3, 6] [GeneInt 6, GeneInt 3, GeneInt 4, GeneInt 2, GeneBool True, StateFunc instructionCodeFromExec, StateFunc instructionIntAdd, StateFunc instructionCodeWhen] emptyState
- boolTestFunc "instructionCodeMemberTrue" [True] [StateFunc instructionCodeFromExec, GeneInt 2, StateFunc instructionCodeFromExec, Block [GeneFloat 3.6, GeneInt 2, GeneIntVector [8, 9]], StateFunc instructionCodeMember] emptyState
- boolTestFunc "instructionCodeMemberFalse" [False] [StateFunc instructionCodeFromExec, GeneInt 7, StateFunc instructionCodeFromExec, Block [GeneFloat 3.6, GeneInt 2, GeneIntVector [8, 9]], StateFunc instructionCodeMember] emptyState
+ boolTestFunc "instructionCodeMemberTrue" [True] [StateFunc instructionCodeFromExec, GeneInt 2, StateFunc instructionCodeFromExec, Block [GeneFloat 3.6, GeneInt 2, GeneIntVector [8, 9]], StateFunc instructionCodeMember] emptyState
+ boolTestFunc "instructionCodeMemberFalse" [False] [StateFunc instructionCodeFromExec, GeneInt 7, StateFunc instructionCodeFromExec, Block [GeneFloat 3.6, GeneInt 2, GeneIntVector [8, 9]], StateFunc instructionCodeMember] emptyState
boolTestFunc "instructionCodeMember2Blocks" [False] [StateFunc instructionCodeFromExec, Block [GeneInt 7, GeneInt 0], StateFunc instructionCodeFromExec, Block [GeneFloat 3.6, GeneInt 2, GeneIntVector [8, 9]], StateFunc instructionCodeMember] emptyState
-
+ codeTestFunc "instructionCodeNInBounds" [GeneInt 0] [StateFunc instructionCodeFromExec, Block [GeneInt 0, GeneInt 1, GeneInt 2, GeneInt 3, GeneInt 4, GeneInt 5], GeneInt 0, StateFunc instructionCodeN] emptyState
+ codeTestFunc "instructionCodeNInBoundsEnd" [GeneInt 5] [StateFunc instructionCodeFromExec, Block [GeneInt 0, GeneInt 1, GeneInt 2, GeneInt 3, GeneInt 4, GeneInt 5], GeneInt 5, StateFunc instructionCodeN] emptyState
+ codeTestFunc "instructionCodeNModded" [GeneInt 3] [StateFunc instructionCodeFromExec, Block [GeneInt 0, GeneInt 1, GeneInt 2, GeneInt 3, GeneInt 4, GeneInt 5], GeneInt 9, StateFunc instructionCodeN] emptyState
+ codeTestFunc "instructionMakeEmptyCodeBlock" [Block []] [StateFunc instructionMakeEmptyCodeBlock] emptyState
+ boolTestFunc "instructionIsEmptyCodeBlockTrue" [True] [StateFunc instructionCodeFromExec, Block [], StateFunc instructionIsEmptyCodeBlock] emptyState
+ intTestFunc "instructionCodeSize" [8] [StateFunc instructionCodeFromExec, Block [GeneInt 1, Block [GeneInt 2, GeneInt 3], Block [GeneInt 4, GeneInt 5], GeneInt 6], StateFunc instructionCodeSize] emptyState
+ codeTestFunc "instructionCodeExtractInBounds" [GeneInt 3] [StateFunc instructionCodeFromExec, Block [GeneInt 1, Block [GeneInt 2, GeneInt 3], Block [GeneInt 4, GeneInt 5], GeneInt 6], GeneInt 3, StateFunc instructionCodeExtract] emptyState
+ codeTestFunc "instructionCodeExtractOutBounds" [GeneInt 3] [StateFunc instructionCodeFromExec, Block [GeneInt 1, Block [GeneInt 2, GeneInt 3], Block [GeneInt 4, GeneInt 5], GeneInt 6], GeneInt 11, StateFunc instructionCodeExtract] emptyState
+ codeTestFunc "instructionCodeExtractLastEmptyBlock" [Block []] [StateFunc instructionCodeFromExec, Block [GeneInt 1, Block [GeneInt 2, GeneInt 3], Block [GeneInt 4, GeneInt 5], Block []], GeneInt 7, StateFunc instructionCodeExtract] emptyState
+ codeTestFunc "instructionCodeExtractBlock" [Block [GeneInt 2, GeneInt 3]] [StateFunc instructionCodeFromExec, Block [GeneInt 1, Block [GeneInt 2, GeneInt 3], Block [GeneInt 4, GeneInt 5], Block []], GeneInt 1, StateFunc instructionCodeExtract] emptyState