diff --git a/src/Instructions/FloatInstructions.hs b/src/Instructions/FloatInstructions.hs index 9064ce2..d1fd0b5 100644 --- a/src/Instructions/FloatInstructions.hs +++ b/src/Instructions/FloatInstructions.hs @@ -55,7 +55,7 @@ instructionFloatPop :: State -> State instructionFloatPop state = instructionPop state float instructionFloatDup :: State -> State -instructionFloatDup state = instructionPop state float +instructionFloatDup state = instructionDup state float instructionFloatDupN :: State -> State instructionFloatDupN state = instructionDupN state float @@ -74,3 +74,15 @@ instructionFloatEq state = instructionEq state float instructionFloatStackDepth :: State -> State instructionFloatStackDepth state = instructionStackDepth state float + +instructionFloatYankDup :: State -> State +instructionFloatYankDup state = instructionYankDup state float + +instructionFloatYank :: State -> State +instructionFloatYank state = instructionYank state float + +instructionFloatShoveDup :: State -> State +instructionFloatShoveDup state = instructionShoveDup state float + +instructionFloatShove :: State -> State +instructionFloatShove state = instructionShove state float diff --git a/src/Instructions/GenericInstructions.hs b/src/Instructions/GenericInstructions.hs index df956d2..9131412 100644 --- a/src/Instructions/GenericInstructions.hs +++ b/src/Instructions/GenericInstructions.hs @@ -66,3 +66,31 @@ instructionEq state accessor = instructionStackDepth :: State -> Lens' State [a] -> State instructionStackDepth state accessor = state & int .~ (length (view accessor state) : view int state) + +-- Will have a non-generic definition for the int stack +instructionYankDup :: State -> Lens' State [a] -> State +instructionYankDup state@(State {_int = i : is}) accessor = + if notEmptyStack state accessor + then (state & accessor .~ (view accessor state !! max 0 (min i (length (view accessor state) - 1))) : view accessor state) {_int = is} + else state +instructionYankDup state@(State {_int = []}) _ = state + +-- Is this optimal? Running instrucitonYankDup twice????? +-- int non generic too +instructionYank :: State -> Lens' State [a] -> State +instructionYank state accessor = instructionYankDup state accessor & accessor .~ init (view accessor (instructionYankDup state accessor)) + +combineTuple :: a -> ([a], [a]) -> [a] +combineTuple val tup = fst tup <> [val] <> snd tup + +-- int non generic :( +instructionShoveDup :: State -> Lens' State [a] -> State +instructionShoveDup state@(State {_int = i : is}) accessor = + if notEmptyStack state accessor + then (state & accessor .~ combineTuple (head $ view accessor state) (splitAt (max 0 (min i (length (view accessor state) - 1))) (view accessor state))) {_int = is} + else state +instructionShoveDup state@(State {_int = []}) _ = state + +-- also also not int generic +instructionShove :: State -> Lens' State [a] -> State +instructionShove state accessor = instructionShoveDup state accessor & accessor .~ drop 1 (view accessor (instructionShoveDup state accessor)) diff --git a/src/Instructions/IntInstructions.hs b/src/Instructions/IntInstructions.hs index ae58588..55ccdb1 100644 --- a/src/Instructions/IntInstructions.hs +++ b/src/Instructions/IntInstructions.hs @@ -79,3 +79,8 @@ instructionIntEq state = instructionEq state int instructionIntStackDepth :: State -> State instructionIntStackDepth state = instructionStackDepth state int + +-- int specific +instructionIntYank :: State -> State +instructionIntYank state@(State {_int = index : i2 : is}) = +instructionIntYank state = state