add more generic instructions, need to fix yank
This commit is contained in:
parent
e84ebee427
commit
ee1779b611
@ -55,7 +55,7 @@ instructionFloatPop :: State -> State
|
|||||||
instructionFloatPop state = instructionPop state float
|
instructionFloatPop state = instructionPop state float
|
||||||
|
|
||||||
instructionFloatDup :: State -> State
|
instructionFloatDup :: State -> State
|
||||||
instructionFloatDup state = instructionPop state float
|
instructionFloatDup state = instructionDup state float
|
||||||
|
|
||||||
instructionFloatDupN :: State -> State
|
instructionFloatDupN :: State -> State
|
||||||
instructionFloatDupN state = instructionDupN state float
|
instructionFloatDupN state = instructionDupN state float
|
||||||
@ -74,3 +74,15 @@ instructionFloatEq state = instructionEq state float
|
|||||||
|
|
||||||
instructionFloatStackDepth :: State -> State
|
instructionFloatStackDepth :: State -> State
|
||||||
instructionFloatStackDepth state = instructionStackDepth state float
|
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
|
||||||
|
@ -66,3 +66,31 @@ instructionEq state accessor =
|
|||||||
|
|
||||||
instructionStackDepth :: State -> Lens' State [a] -> State
|
instructionStackDepth :: State -> Lens' State [a] -> State
|
||||||
instructionStackDepth state accessor = state & int .~ (length (view accessor state) : view int 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))
|
||||||
|
@ -79,3 +79,8 @@ instructionIntEq state = instructionEq state int
|
|||||||
|
|
||||||
instructionIntStackDepth :: State -> State
|
instructionIntStackDepth :: State -> State
|
||||||
instructionIntStackDepth state = instructionStackDepth state int
|
instructionIntStackDepth state = instructionStackDepth state int
|
||||||
|
|
||||||
|
-- int specific
|
||||||
|
instructionIntYank :: State -> State
|
||||||
|
instructionIntYank state@(State {_int = index : i2 : is}) =
|
||||||
|
instructionIntYank state = state
|
||||||
|
Loading…
x
Reference in New Issue
Block a user