diff --git a/src/Instructions/CodeInstructions.hs b/src/Instructions/CodeInstructions.hs index 9fbb5f3..1caf48b 100644 --- a/src/Instructions/CodeInstructions.hs +++ b/src/Instructions/CodeInstructions.hs @@ -126,13 +126,19 @@ instructionCodeDoDup state = state -- https://erp12.github.io/pyshgp/html/core_instructions.html#code-do-then-pop instructionCodeDoThenPop :: State -> State -instructionCodeDoThenPop state@(State {_code = c1 : _, _exec = es}) = state {_exec = c1 : StateFunc instructionCodePop : es} +instructionCodeDoThenPop state@(State {_code = c1 : _, _exec = es}) = state {_exec = c1 : StateFunc (instructionCodePop, "instructionCodePop") : es} instructionCodeDoThenPop state = state +codeFromExec :: Gene +codeFromExec = StateFunc (instructionCodeFromExec, "instructionCodeFromExec") + +codeDoRange :: Gene +codeDoRange = StateFunc (instructionCodeDoRange, "instructionCodeDoRange") + instructionCodeDoRange :: State -> State instructionCodeDoRange state@(State {_code = (c1 : cs), _int = (i0 : i1 : is), _exec = es}) = if increment i0 i1 /= 0 - then state {_exec = c1 : Block [GeneInt (i1 + increment i0 i1), GeneInt i0, StateFunc instructionCodeFromExec, c1, StateFunc instructionCodeDoRange] : es, _int = i1 : is, _code = cs} + then state {_exec = c1 : Block [GeneInt (i1 + increment i0 i1), GeneInt i0, codeFromExec, c1, codeDoRange] : es, _int = i1 : is, _code = cs} else state {_exec = c1: es, _int = i1 : is, _code = cs} where increment :: Int -> Int -> Int @@ -146,14 +152,14 @@ instructionCodeDoCount :: State -> State instructionCodeDoCount state@(State {_code = (c : cs), _int = (i : is), _exec = es}) = if i < 1 then state - else state {_code = cs, _int = is, _exec = Block [GeneInt 0, GeneInt $ i - 1, StateFunc instructionCodeFromExec, c, StateFunc instructionCodeDoRange] : es} + else state {_code = cs, _int = is, _exec = Block [GeneInt 0, GeneInt $ i - 1, codeFromExec, c, codeDoRange] : es} instructionCodeDoCount state = state instructionCodeDoTimes :: State -> State instructionCodeDoTimes state@(State {_code = (c : cs), _int = (i : is), _exec = es}) = if i < 1 then state - else state {_code = cs, _int = is, _exec = Block [GeneInt 0, GeneInt $ i - 1, StateFunc instructionCodeFromExec, Block [StateFunc instructionIntPop, c], StateFunc instructionCodeDoRange] : es} + else state {_code = cs, _int = is, _exec = Block [GeneInt 0, GeneInt $ i - 1, codeFromExec, Block [StateFunc (instructionIntPop, "instructionIntPop"), c], codeDoRange] : es} instructionCodeDoTimes state = state instructionCodeIf :: State -> State diff --git a/src/Instructions/ExecInstructions.hs b/src/Instructions/ExecInstructions.hs index 9b6357a..c0ab519 100644 --- a/src/Instructions/ExecInstructions.hs +++ b/src/Instructions/ExecInstructions.hs @@ -50,10 +50,13 @@ instructionExecShoveDup state = instructionShoveDup state exec instructionExecIsEmpty :: State -> State instructionExecIsEmpty state = instructionIsEmpty state exec +execDoRange :: Gene +execDoRange = StateFunc (instructionExecDoRange, "instructionExecDoRange") + instructionExecDoRange :: State -> State instructionExecDoRange state@(State {_exec = (e1 : es), _int = (i0 : i1 : is)}) = if increment i0 i1 /= 0 - then state {_exec = e1 : Block [GeneInt (i1 + increment i0 i1), GeneInt i0, StateFunc instructionExecDoRange, e1] : es, _int = i1 : is} + then state {_exec = e1 : Block [GeneInt (i1 + increment i0 i1), GeneInt i0, execDoRange, e1] : es, _int = i1 : is} else state {_exec = e1 : es, _int = i1 : is} where increment :: Int -> Int -> Int @@ -67,28 +70,31 @@ instructionExecDoCount :: State -> State instructionExecDoCount state@(State {_exec = (e : es), _int = (i : is)}) = if i < 1 then state - else state {_exec = Block [GeneInt 0, GeneInt $ i - 1, StateFunc instructionExecDoRange, e] : es, _int = is} + else state {_exec = Block [GeneInt 0, GeneInt $ i - 1, execDoRange, e] : es, _int = is} instructionExecDoCount state = state instructionExecDoTimes :: State -> State instructionExecDoTimes state@(State {_exec = (e : es), _int = (i : is)}) = if i < 1 then state - else state {_exec = Block [GeneInt 0, GeneInt $ i - 1, StateFunc instructionExecDoRange, Block [StateFunc instructionIntPop, e]] : es, _int = is} + else state {_exec = Block [GeneInt 0, GeneInt $ i - 1, execDoRange, Block [StateFunc (instructionIntPop, "instructionIntPop"), e]] : es, _int = is} instructionExecDoTimes state = state +execWhile :: Gene +execWhile = StateFunc (instructionExecWhile, "instructionExecWhile") + instructionExecWhile :: State -> State instructionExecWhile state@(State {_exec = (_ : es), _bool = []}) = state {_exec = es} instructionExecWhile state@(State {_exec = alles@(e : es), _bool = (b : bs)}) = if b - then state {_exec = e : StateFunc instructionExecWhile : alles, _bool = bs} + then state {_exec = e : execWhile : alles, _bool = bs} else state {_exec = es} instructionExecWhile state = state instructionExecDoWhile :: State -> State instructionExecDoWhile state@(State {_exec = alles@(e : _)}) = - state {_exec = e : StateFunc instructionExecWhile : alles} + state {_exec = e : execWhile : alles} instructionExecDoWhile state = state -- Eats the _boolean no matter what diff --git a/src/Instructions/GenericInstructions.hs b/src/Instructions/GenericInstructions.hs index 872fff1..aac7bbc 100644 --- a/src/Instructions/GenericInstructions.hs +++ b/src/Instructions/GenericInstructions.hs @@ -327,17 +327,17 @@ instructionVectorRemove state primAccessor vectorAccessor = (Just (v1, vs), Just (p1, ps)) -> state & vectorAccessor .~ (replace v1 [p1] [] Nothing : vs) & primAccessor .~ ps _ -> state -instructionVectorIterate :: State -> Lens' State [a] -> Lens' State [[a]] -> ([a] -> Gene) -> (State -> State) -> State -instructionVectorIterate state@(State {_exec = e1 : es}) primAccessor vectorAccessor vectorType typeIterateFunction = +instructionVectorIterate :: State -> Lens' State [a] -> Lens' State [[a]] -> ([a] -> Gene) -> (State -> State) -> String -> State +instructionVectorIterate state@(State {_exec = e1 : es}) primAccessor vectorAccessor vectorType typeIterateFunction typeIterateFunctionName = case uncons (view vectorAccessor state) of Just ([], vs) -> state{_exec = es} & vectorAccessor .~ vs Just ([x], vs) -> state & primAccessor .~ (x : view primAccessor state) & vectorAccessor .~ vs Just (v1, vs) -> (case uncons v1 of - Just (nv1, nvs) -> state{_exec = e1 : vectorType nvs : StateFunc typeIterateFunction : e1 : es} & primAccessor .~ (nv1 : view primAccessor state) & vectorAccessor .~ vs + Just (nv1, nvs) -> state{_exec = e1 : vectorType nvs : StateFunc (typeIterateFunction, typeIterateFunctionName) : e1 : es} & primAccessor .~ (nv1 : view primAccessor state) & vectorAccessor .~ vs _ -> state) -- This should never happen _ -> state -instructionVectorIterate state _ _ _ _ = state +instructionVectorIterate state _ _ _ _ _ = state instructionCodeFrom :: State -> Lens' State [a] -> (a -> Gene) -> State instructionCodeFrom state@(State {_code = cs}) accessor geneType = diff --git a/src/Instructions/VectorCharInstructions.hs b/src/Instructions/VectorCharInstructions.hs index 30c9d0b..7467163 100644 --- a/src/Instructions/VectorCharInstructions.hs +++ b/src/Instructions/VectorCharInstructions.hs @@ -64,7 +64,7 @@ instructionVectorCharRemove :: State -> State instructionVectorCharRemove state = instructionVectorRemove state char vectorChar instructionVectorCharIterate :: State -> State -instructionVectorCharIterate state = instructionVectorIterate state char vectorChar GeneVectorChar instructionVectorCharIterate +instructionVectorCharIterate state = instructionVectorIterate state char vectorChar GeneVectorChar instructionVectorCharIterate "instructionVectorCharIterate" instructionVectorCharPop :: State -> State instructionVectorCharPop state = instructionPop state vectorChar diff --git a/src/Instructions/VectorFloatInstructions.hs b/src/Instructions/VectorFloatInstructions.hs index b45f2dc..18dabc9 100644 --- a/src/Instructions/VectorFloatInstructions.hs +++ b/src/Instructions/VectorFloatInstructions.hs @@ -64,7 +64,7 @@ instructionVectorFloatRemove :: State -> State instructionVectorFloatRemove state = instructionVectorRemove state float vectorFloat instructionVectorFloatIterate :: State -> State -instructionVectorFloatIterate state = instructionVectorIterate state float vectorFloat GeneVectorFloat instructionVectorFloatIterate +instructionVectorFloatIterate state = instructionVectorIterate state float vectorFloat GeneVectorFloat instructionVectorFloatIterate "instructionVectorFloatIterate" instructionVectorFloatPop :: State -> State instructionVectorFloatPop state = instructionPop state vectorFloat diff --git a/src/Instructions/VectorIntInstructions.hs b/src/Instructions/VectorIntInstructions.hs index 7bf3bf3..bb135ff 100644 --- a/src/Instructions/VectorIntInstructions.hs +++ b/src/Instructions/VectorIntInstructions.hs @@ -64,7 +64,7 @@ instructionVectorIntRemove :: State -> State instructionVectorIntRemove state = instructionVectorRemove state int vectorInt instructionVectorIntIterate :: State -> State -instructionVectorIntIterate state = instructionVectorIterate state int vectorInt GeneVectorInt instructionVectorIntIterate +instructionVectorIntIterate state = instructionVectorIterate state int vectorInt GeneVectorInt instructionVectorIntIterate "instructionVectorIntIterate" instructionVectorIntPop :: State -> State instructionVectorIntPop state = instructionPop state vectorChar diff --git a/src/Instructions/VectorLogicalInstructions.hs b/src/Instructions/VectorLogicalInstructions.hs index af5e0f5..35d7add 100644 --- a/src/Instructions/VectorLogicalInstructions.hs +++ b/src/Instructions/VectorLogicalInstructions.hs @@ -64,7 +64,7 @@ instructionVectorBoolRemove :: State -> State instructionVectorBoolRemove state = instructionVectorRemove state bool vectorBool instructionVectorBoolIterate :: State -> State -instructionVectorBoolIterate state = instructionVectorIterate state bool vectorBool GeneVectorBool instructionVectorBoolIterate +instructionVectorBoolIterate state = instructionVectorIterate state bool vectorBool GeneVectorBool instructionVectorBoolIterate "instructionVectorBoolIterate" instructionVectorBoolPop :: State -> State instructionVectorBoolPop state = instructionPop state vectorBool diff --git a/src/Instructions/VectorStringInstructions.hs b/src/Instructions/VectorStringInstructions.hs index ee524d6..def670a 100644 --- a/src/Instructions/VectorStringInstructions.hs +++ b/src/Instructions/VectorStringInstructions.hs @@ -64,7 +64,7 @@ instructionVectorStringRemove :: State -> State instructionVectorStringRemove state = instructionVectorRemove state string vectorString instructionVectorStringIterate :: State -> State -instructionVectorStringIterate state = instructionVectorIterate state string vectorString GeneVectorString instructionVectorStringIterate +instructionVectorStringIterate state = instructionVectorIterate state string vectorString GeneVectorString instructionVectorStringIterate "instructionVectorStringIterate" instructionVectorStringPop :: State -> State instructionVectorStringPop state = instructionPop state vectorString