diff --git a/src/Push.hs b/src/Push.hs index 627839b..1377f51 100644 --- a/src/Push.hs +++ b/src/Push.hs @@ -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?