cleaning these up, still have work to do
This commit is contained in:
parent
2dd054f17e
commit
7c9cdb8ed8
@ -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
|
||||||
|
@ -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]
|
||||||
|
Loading…
x
Reference in New Issue
Block a user