diff --git a/src/Instructions/CharInstructions.hs b/src/Instructions/CharInstructions.hs index 92e34ee..714272c 100644 --- a/src/Instructions/CharInstructions.hs +++ b/src/Instructions/CharInstructions.hs @@ -2,7 +2,8 @@ module Instructions.CharInstructions where import Data.Char import State -import Instructions.GenericInstructions +import Data.List (uncons) +-- import Instructions.GenericInstructions import Instructions.StringInstructions (wschars) intToAscii :: (Integral a) => a -> Char @@ -14,9 +15,9 @@ instructionCharConcat state = state instructionCharFromFirstChar :: State -> State instructionCharFromFirstChar state@(State {_char = cs, _string = s1 : ss}) = - if not $ null s1 - then state {_char = head s1 : cs, _string = ss} - else state + case uncons s1 of + Nothing -> state + Just (x,_) -> state {_char = x : cs, _string = ss} instructionCharFromFirstChar state = state instructionCharFromLastChar :: State -> State diff --git a/src/Instructions/GenericInstructions.hs b/src/Instructions/GenericInstructions.hs index cb7acc7..50856c5 100644 --- a/src/Instructions/GenericInstructions.hs +++ b/src/Instructions/GenericInstructions.hs @@ -70,7 +70,10 @@ notEmptyStack state accessor = not . null $ view accessor state -- This head error should never happen 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 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 accessor = 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 where 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 state accessor = 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 where stackTop :: [a]