uncons to stop warnings
This commit is contained in:
parent
c9923eae02
commit
89287ceaed
@ -76,17 +76,20 @@ instructionDup state accessor =
|
|||||||
Just (x,_) -> state & accessor .~ x : view accessor state
|
Just (x,_) -> state & accessor .~ x : view accessor state
|
||||||
|
|
||||||
instructionPop :: State -> Lens' State [a] -> State
|
instructionPop :: State -> Lens' State [a] -> State
|
||||||
instructionPop state accessor = if notEmptyStack state accessor then state & accessor .~ drop 1 (view accessor state) else state
|
instructionPop state accessor = state & accessor .~ drop 1 (view accessor state)
|
||||||
|
|
||||||
|
-- instructionPop :: State -> Lens' State [a] -> State
|
||||||
|
-- instructionPop state accessor = if notEmptyStack state accessor then instructionPop state accessor else state
|
||||||
|
|
||||||
-- I might be able to move some of the int stack error checking
|
-- I might be able to move some of the int stack error checking
|
||||||
-- to the integer call. For now this may be a tad inefficient.
|
-- to the integer call. For now this may be a tad inefficient.
|
||||||
instructionDupN :: State -> Lens' State [a] -> State
|
instructionDupN :: State -> Lens' State [a] -> State
|
||||||
instructionDupN state accessor =
|
instructionDupN state accessor =
|
||||||
if notEmptyStack state accessor && notEmptyStack state int
|
if notEmptyStack state accessor
|
||||||
then
|
then
|
||||||
case uncons (view int state) of
|
case uncons (view int state) of
|
||||||
Nothing -> state -- is this redundant?
|
Just (i1,_) -> instructionDupNHelper i1 accessor (instructionPop state int)
|
||||||
Just (x,_) -> instructionDupNHelper x accessor (instructionPop state int)
|
_ -> state
|
||||||
else state
|
else state
|
||||||
where
|
where
|
||||||
instructionDupNHelper :: Int -> Lens' State [a] -> State -> State
|
instructionDupNHelper :: Int -> Lens' State [a] -> State -> State
|
||||||
@ -165,9 +168,9 @@ instructionYank state _ = state
|
|||||||
-- Rewrite this eventually?
|
-- Rewrite this eventually?
|
||||||
instructionShoveDup :: State -> Lens' State [a] -> State
|
instructionShoveDup :: State -> Lens' State [a] -> State
|
||||||
instructionShoveDup state@(State {_int = i : is}) accessor =
|
instructionShoveDup state@(State {_int = i : is}) accessor =
|
||||||
if notEmptyStack state accessor
|
case uncons (view accessor state) of
|
||||||
then (state & accessor .~ combineTuple (head $ view accessor state) (splitAt (max 0 (min i (length (view accessor state) - 1))) (view accessor state))) {_int = is}
|
Just (x,_) -> (state & accessor .~ combineTuple x (splitAt (max 0 (min i (length (view accessor state) - 1))) (view accessor state))) {_int = is}
|
||||||
else state
|
_ -> state
|
||||||
instructionShoveDup state@(State {_int = []}) _ = state
|
instructionShoveDup state@(State {_int = []}) _ = state
|
||||||
|
|
||||||
-- also also not int generic
|
-- also also not int generic
|
||||||
@ -177,10 +180,9 @@ instructionShove state accessor = instructionShoveDup state accessor & accessor
|
|||||||
-- not char generic
|
-- not char generic
|
||||||
instructionConcat :: Semigroup a => State -> Lens' State [a] -> State
|
instructionConcat :: Semigroup a => State -> Lens' State [a] -> State
|
||||||
instructionConcat state accessor =
|
instructionConcat state accessor =
|
||||||
if (length . take 2 $ view accessor state) == 2
|
case uncons (view accessor state) of
|
||||||
then droppedState & accessor .~ (head (view accessor state) <> view accessor state !! 1) : view accessor droppedState
|
Just (x1, x2:_) -> droppedState & accessor .~ (x1 <> x2) : view accessor droppedState
|
||||||
-- then undefined
|
_ -> state
|
||||||
else state
|
|
||||||
where
|
where
|
||||||
droppedState :: State
|
droppedState :: State
|
||||||
droppedState = state & accessor .~ drop 2 (view accessor state)
|
droppedState = state & accessor .~ drop 2 (view accessor state)
|
||||||
|
Loading…
x
Reference in New Issue
Block a user