cleaning these up, still have work to do

This commit is contained in:
Rowan Torbitzky-Lane 2025-01-26 20:05:05 -06:00
parent 2dd054f17e
commit 7c9cdb8ed8
2 changed files with 19 additions and 7 deletions

View File

@ -2,7 +2,8 @@ module Instructions.CharInstructions where
import Data.Char import Data.Char
import State import State
import Instructions.GenericInstructions import Data.List (uncons)
-- import Instructions.GenericInstructions
import Instructions.StringInstructions (wschars) import Instructions.StringInstructions (wschars)
intToAscii :: (Integral a) => a -> Char intToAscii :: (Integral a) => a -> Char
@ -14,9 +15,9 @@ instructionCharConcat state = state
instructionCharFromFirstChar :: State -> State instructionCharFromFirstChar :: State -> State
instructionCharFromFirstChar state@(State {_char = cs, _string = s1 : ss}) = instructionCharFromFirstChar state@(State {_char = cs, _string = s1 : ss}) =
if not $ null s1 case uncons s1 of
then state {_char = head s1 : cs, _string = ss} Nothing -> state
else state Just (x,_) -> state {_char = x : cs, _string = ss}
instructionCharFromFirstChar state = state instructionCharFromFirstChar state = state
instructionCharFromLastChar :: State -> State instructionCharFromLastChar :: State -> State

View File

@ -70,7 +70,10 @@ notEmptyStack state accessor = not . null $ view accessor state
-- This head error should never happen -- This head error should never happen
instructionDup :: State -> Lens' State [a] -> State instructionDup :: State -> Lens' State [a] -> State
instructionDup state accessor = if notEmptyStack state accessor then state & accessor .~ head (view accessor state) : view accessor state else state instructionDup state accessor =
case uncons (view accessor state) of
Nothing -> 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 = if notEmptyStack state accessor then state & accessor .~ drop 1 (view accessor state) else state
@ -80,7 +83,10 @@ instructionPop state accessor = if notEmptyStack state accessor then state & acc
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 && notEmptyStack state int
then instructionDupNHelper (head (view int state)) accessor (instructionPop state int) then
case uncons (view int state) of
Nothing -> state -- is this redundant?
Just (x,_) -> instructionDupNHelper x accessor (instructionPop state int)
else state else state
where where
instructionDupNHelper :: Int -> Lens' State [a] -> State -> State instructionDupNHelper :: Int -> Lens' State [a] -> State -> State
@ -118,7 +124,12 @@ instructionFlush state accessor = state & accessor .~ []
instructionEq :: forall a. Eq a => State -> Lens' State [a] -> State instructionEq :: forall a. Eq a => State -> Lens' State [a] -> State
instructionEq state accessor = instructionEq state accessor =
if length stackTop == 2 if length stackTop == 2
then state & bool .~ (head stackTop == stackTop !! 1) : view bool state & accessor .~ drop 2 (view accessor state) -- then state & bool .~ (head stackTop == stackTop !! 1) : view bool state & accessor .~ drop 2 (view accessor state)
then
case uncons stackTop of
Nothing -> state
Just (x1, x2 : _) -> state & bool .~ (x1 == x2) : view bool state & accessor .~ drop 2 (view accessor state)
Just _ -> state
else state else state
where where
stackTop :: [a] stackTop :: [a]