uncons to stop warnings

This commit is contained in:
Rowan Torbitzky-Lane 2025-01-27 12:19:54 -06:00
parent c9923eae02
commit 89287ceaed

View File

@ -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)