rowan.a.tl/HushGP
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

need to test changes

Browse Source
This commit is contained in:
Rowan Torbitzky-Lane 2025-01-16 12:32:26 -06:00
parent 13bf8e0888
commit 65c13de8bc
1 changed files with 46 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

90
src/Push.hs
View File

@ -1,3 +1,5 @@
{-# LANGUAGE RecordWildCards #-}
module Push where
-- import Debug.Trace (trace, traceStack)
@ -67,78 +69,78 @@ emptyState =
-- Everntually, this can be part of the apply func to state helpers,
-- which should take the number and type of parameter they have.
instructionIntAdd :: State -> State
instructionIntAdd (State es (i1 : i2 : is) fs bs ss ps im) = State es (i2 + i1 : is) fs bs ss ps im
instructionIntAdd state@(State {int = (i1 : i2 : is), ..}) = state {int = i1 + i2 : is}
instructionIntAdd state = state
instructionIntSub :: State -> State
instructionIntSub (State es (i1 : i2 : is) fs bs ss ps im) = State es (i2 - i1 : is) fs bs ss ps im
instructionIntSub state@(State {int = (i1 : i2 : is), ..}) = state {int = i1 - i2 : is}
instructionIntSub state = state
instructionIntMul :: State -> State
instructionIntMul (State es (i1 : i2 : is) fs bs ss ps im) = State es (i2 * i1 : is) fs bs ss ps im
instructionIntMul state@(State {int = (i1 : i2 : is), ..}) = state {int = i1 * i2 : is}
instructionIntMul state = state
instructionIntDiv :: State -> State
instructionIntDiv (State es (i1 : i2 : is) fs bs ss ps im) = State es (i2 `div` i1 : is) fs bs ss ps im
instructionIntDiv state@(State {int = (i1 : i2 : is), ..}) = state {int = i1 `div` i2 : is}
instructionIntDiv state = state
instructionIntMod :: State -> State
instructionIntMod (State es (i1 : i2 : is) fs bs ss ps im) = State es (i2 `mod` i1 : is) fs bs ss ps im
instructionIntMod state@(State {int = (i1 : i2 : is), ..}) = state {int = i1 `mod` i2 : is}
instructionIntMod state = state
instructionIntMin :: State -> State
instructionIntMin state@(State es (i1 : i2 : is) fs bs ss ps im) = state {int = min i1 i2 : is}
instructionIntMin state@(State {int = (i1 : i2 : is), ..}) = state {int = min i1 i2 : is}
instructionIntMin state = state
instructionIntMax :: State -> State
instructionIntMax state@(State es (i1 : i2 : is) fs bs ss ps im) = state {int = max i1 i2 : is}
instructionIntMax state@(State {int = (i1 : i2 : is), ..}) = state {int = max i1 i2 : is}
instructionIntMax state = state
instructionIntInc :: State -> State
instructionIntInc state@(State es (i1 : is) fs bs ss ps im) = state {int = i1 + 1 : is}
instructionIntInc state@(State {int = (i1 : is), ..}) = state {int = i1 + 1 : is}
instructionIntInc state = state
instructionIntDec :: State -> State
instructionIntDec state@(State es (i1 : is) fs bs ss ps im) = state {int = i1 - 1 : is}
instructionIntDec state@(State {int = (i1 : is), ..}) = state {int = i1 - 1 : is}
instructionIntDec state = state
instructionIntLT :: State -> State
instructionIntLT state@(State es (i1 : i2 : is) fs bs ss ps im) = state {int = is, bool = (i1 < i2) : bs}
instructionIntLT state@(State {int = i1 : i2 : is, bool = bs, ..}) = state {int = is, bool = (i1 < i2) : bs}
instructionIntLT state = state
instructionIntGT :: State -> State
instructionIntGT state@(State es (i1 : i2 : is) fs bs ss ps im) = state {int = is, bool = (i1 > i2) : bs}
instructionIntGT state@(State {int = i1 : i2 : is, bool = bs, ..}) = state {int = is, bool = (i1 > i2) : bs}
instructionIntGT state = state
instructionIntLTE :: State -> State
instructionIntLTE state@(State es (i1 : i2 : is) fs bs ss ps im) = state {int = is, bool = (i1 <= i2) : bs}
instructionIntLTE state@(State {int = i1 : i2 : is, bool = bs, ..}) = state {int = is, bool = (i1 <= i2) : bs}
instructionIntLTE state = state
instructionIntGTE :: State -> State
instructionIntGTE state@(State es (i1 : i2 : is) fs bs ss ps im) = state {int = is, bool = (i1 >= i2) : bs}
instructionIntGTE state@(State {int = i1 : i2 : is, bool = bs, ..}) = state {int = is, bool = (i1 >= i2) : bs}
instructionIntGTE state = state
instructionIntPop :: State -> State
instructionIntPop state@(State es (i1 : is) fs bs ss ps im) = state {int = is}
instructionIntPop state@(State {int = (i1 : is), ..}) = state {int = is}
instructionIntPop state = state
instructionExecIf :: State -> State
instructionExecIf (State (e1 : e2 : es) is fs (b : bs) ss ps im) =
case b of
True -> State (e1 : es) is fs bs ss ps im
False -> State (e2 : es) is fs bs ss ps im
instructionExecIf state@(State {exec = (e1 : e2 : es), bool = (b : bs), ..}) =
if b
then state {exec = e1 : es}
else state {exec = e2 : es}
instructionExecIf state = state
instructionExecDup :: State -> State
instructionExecDup (State alles@(e0 : es) is fs bs ss pm im) =
State (e0 : alles) is fs bs ss pm im
instructionExecDup state@(State {exec = alles@(e0 : es), ..}) =
state {exec = e0 : alles}
instructionExecDup state = state
instructionExecDoRange :: State -> State
instructionExecDoRange (State (e1 : es) (i0 : i1 : is) fs bs ss ps im) =
instructionExecDoRange state@(State {exec = (e1 : es), int = (i0 : i1 : is), ..}) =
if increment i0 i1 /= 0
then State (e1 : Block [IntGene (i1 + increment i0 i1), IntGene i0, StateFunc instructionExecDoRange, e1] : es) (i1 : is) fs bs ss ps im
else State (e1 : es) (i1 : is) fs bs ss ps im
then state {exec = e1 : Block [IntGene (i1 + increment i0 i1), IntGene i0, StateFunc instructionExecDoRange, e1] : es, int = i1 : is}
else state {exec = e1 : es, int = i1 : is}
where
increment :: Int -> Int -> Int
increment destIdx currentIdx
@ -148,36 +150,36 @@ instructionExecDoRange (State (e1 : es) (i0 : i1 : is) fs bs ss ps im) =
instructionExecDoRange state = state
instructionExecDoCount :: State -> State
instructionExecDoCount state@(State (e1 : es) (i1 : is) fs bs ss ps im) =
instructionExecDoCount state@(State {exec = (e1 : es), int = (i1 : is), ..}) =
if i1 < 1
then state
else state {exec = Block [IntGene 0, IntGene $ i1 - 1, StateFunc instructionExecDoRange, e1] : es, int = is}
instructionExecDoCount state = state
instructionExecDoTimes :: State -> State
instructionExecDoTimes state@(State (e1 : es) (i1 : is) fs bs ss ps im) =
instructionExecDoTimes state@(State {exec = (e1 : es), int = (i1 : is), ..}) =
if i1 < 1
then state
else state {exec = Block [IntGene 0, IntGene $ i1 - 1, StateFunc instructionExecDoRange, Block [StateFunc instructionIntPop, e1]] : es, int = is}
instructionExecDoTimes state = state
instructionExecWhile :: State -> State
instructionExecWhile state@(State (e1 : es) is fs [] ss ps im) =
instructionExecWhile state@(State {exec = (e1 : es), bool = [], ..}) =
state {exec = es}
instructionExecWhile state@(State alles@(e1 : es) is fs (b1 : bs) ss ps im) =
instructionExecWhile state@(State {exec = alles@(e1 : es), bool = (b1 : bs), ..}) =
if b1
then state {exec = e1 : StateFunc instructionExecWhile : alles, bool = bs}
else state {exec = es}
instructionExecWhile state = state
instructionExecDoWhile :: State -> State
instructionExecDoWhile state@(State alles@(e1 : es) is fs bs ss ps im) =
instructionExecDoWhile state@(State {exec = alles@(e1 : es), ..}) =
state {exec = e1 : StateFunc instructionExecWhile : alles}
instructionExecDoWhile state = state
-- Eats the boolean no matter what
instructionExecWhen :: State -> State
instructionExecWhen state@(State (e1 : es) is fs (b1 : bs) ss ps im) =
instructionExecWhen state@(State {exec = (e1 : es), bool = (b1 : bs), ..}) =
if not b1
then state {exec = es, bool = bs}
else state {bool = bs}
@ -186,16 +188,16 @@ instructionExecWhen state = state
-- This is one of the push genome functions itself, not infrastructure.
-- Optionally, split this off into independent functions
instructionParameterLoad :: State -> State
instructionParameterLoad (State es is fs bs ss (p : ps) im) = case p of
(IntGene val) -> State es (val : is) fs bs ss ps im
(FloatGene val) -> State es is (val : fs) bs ss ps im
(BoolGene val) -> State es is fs (val : bs) ss ps im
(StringGene val) -> State es is fs bs (val : ss) ps im
instructionParameterLoad state@(State {parameter = (p : ps), ..}) = case p of
(IntGene val) -> state {int = val : int}
(FloatGene val) -> state {float = val : float}
(BoolGene val) -> state {bool = val : bool}
(StringGene val) -> state {string = val : string}
instructionParameterLoad state = state
-- Loads a genome into the exec stack
loadProgram :: [Gene] -> State -> State
loadProgram newstack (State _ i f b s p im) = State newstack i f b s p im
loadProgram newstack state@(State {exec = _, ..}) = state {exec = newstack}
-- Takes a Push state, and generates the next push state via:
-- If the first item on the EXEC stack is a single instruction
@ -208,15 +210,15 @@ loadProgram newstack (State _ i f b s p im) = State newstack i f b s p im
-- ends up on top).
-- The empty-stack safety of interpretExec on empty stacks depends on the functions it calls.
interpretExec :: State -> State
interpretExec (State [] is fs bs ss ps im) = State [] is fs bs ss ps im
interpretExec (State (e : es) is fs bs ss ps im) =
interpretExec state@(State {exec = [], ..}) = state {exec = []}
interpretExec state@(State {exec = (e : es), ..}) =
case e of
(IntGene val) -> interpretExec (State es (val : is) fs bs ss ps im)
(FloatGene val) -> interpretExec (State es is (val : fs) bs ss ps im)
(BoolGene val) -> interpretExec (State es is fs (val : bs) ss ps im)
(StringGene val) -> interpretExec (State es is fs bs (val : ss) ps im)
(StateFunc func) -> interpretExec (func (State es is fs bs ss ps im))
(Block block) -> interpretExec (State (block ++ es) is fs bs ss ps im)
(PlaceInput input) -> interpretExec (State (im Map.! input : es) is fs bs ss ps im)
(IntGene val) -> interpretExec state {int = val : int}
(FloatGene val) -> interpretExec (state {float = val : float})
(BoolGene val) -> interpretExec (state {bool = val : bool})
(StringGene val) -> interpretExec (state {string = val : string})
(StateFunc func) -> interpretExec $ func state
(Block block) -> interpretExec (state {exec = block ++ es})
(PlaceInput val) -> interpretExec (state {exec = (input Map.! val) : es})
-- Need to make interpretExec strict, right?