diff --git a/src/Instructions/CharInstructions.hs b/src/Instructions/CharInstructions.hs index 0f3626f..92e34ee 100644 --- a/src/Instructions/CharInstructions.hs +++ b/src/Instructions/CharInstructions.hs @@ -1,7 +1,12 @@ module Instructions.CharInstructions where +import Data.Char import State import Instructions.GenericInstructions +import Instructions.StringInstructions (wschars) + +intToAscii :: (Integral a) => a -> Char +intToAscii val = chr (abs (fromIntegral val) `mod` 128) instructionCharConcat :: State -> State instructionCharConcat state@(State {_char = c1 : c2 : cs, _string = ss}) = state{_char = cs, _string = [c1, c2] : ss} @@ -28,3 +33,31 @@ instructionCharFromNthChar state@(State {_char = cs, _string = s1 : ss, _int = i in state{_char = s1 !! index : cs, _string = ss, _int = is} instructionCharFromNthChar state = state + +instructionCharIsWhitespace :: State -> State +instructionCharIsWhitespace state@(State {_char = c1 : cs, _bool = bs}) = state{_char = cs, _bool = (c1 `elem` wschars) : bs} +instructionCharIsWhitespace state = state + +instructionCharIsLetter :: State -> State +instructionCharIsLetter state@(State {_char = c1 : cs, _bool = bs}) = state{_char = cs, _bool = isAlpha c1 : bs} +instructionCharIsLetter state = state + +instructionCharIsDigit :: State -> State +instructionCharIsDigit state@(State {_char = c1 : cs, _bool = bs}) = state{_char = cs, _bool = isDigit c1 : bs} +instructionCharIsDigit state = state + +instructionCharFromBool :: State -> State +instructionCharFromBool state@(State {_char = cs, _bool = b1 : bs}) = state{_char = (if b1 then 'T' else 'F') : cs, _bool = bs} +instructionCharFromBool state = state + +instructionCharFromAsciiInt :: State -> State +instructionCharFromAsciiInt state@(State {_char = cs, _int = i1 : is}) = state{_char = intToAscii i1 : cs, _int = is} +instructionCharFromAsciiInt state = state + +instructionCharFromAsciiFloat :: State -> State +instructionCharFromAsciiFloat state@(State {_char = cs, _float = f1 : fs}) = state{_char = intToAscii @Integer (floor f1) : cs, _float = fs} +instructionCharFromAsciiFloat state = state + +instructionCharsFromString :: State -> State +instructionCharsFromString state@(State {_char = cs, _string = s1 : ss}) = state{_char = s1 <> cs, _string = ss} +instructionCharsFromString state = state diff --git a/src/Instructions/ExecInstructions.hs b/src/Instructions/ExecInstructions.hs index 5c5888d..4177292 100644 --- a/src/Instructions/ExecInstructions.hs +++ b/src/Instructions/ExecInstructions.hs @@ -5,10 +5,10 @@ import Instructions.IntInstructions import Instructions.GenericInstructions instructionExecIf :: State -> State -instructionExecIf state@(State {_exec = (e1 : e2 : es), _bool = (b : _)}) = +instructionExecIf state@(State {_exec = (e1 : e2 : es), _bool = (b : bs)}) = if b - then state {_exec = e1 : es} - else state {_exec = e2 : es} + then state {_exec = e1 : es, _bool = bs} + else state {_exec = e2 : es, _bool = bs} instructionExecIf state = state instructionExecDup :: State -> State diff --git a/src/Instructions/GenericInstructions.hs b/src/Instructions/GenericInstructions.hs index 8f945a1..3311a04 100644 --- a/src/Instructions/GenericInstructions.hs +++ b/src/Instructions/GenericInstructions.hs @@ -8,6 +8,19 @@ import State deleteAt :: Int -> [a] -> [a] deleteAt idx xs = take idx xs <> drop 1 (drop idx xs) +combineTuple :: a -> ([a], [a]) -> [a] +combineTuple val tup = fst tup <> [val] <> snd tup + +combineTupleList :: [a] -> ([a], [a]) -> [a] +combineTupleList val tup = fst tup <> val <> snd tup + + +insertAt :: Int -> a -> [a] -> [a] +insertAt idx val xs = combineTuple val (splitAt idx xs) + +replaceAt :: Int -> a -> [a] -> [a] +replaceAt idx val xs = deleteAt (idx + 1) (insertAt idx val xs) + findSubA :: forall a. Eq a => [a] -> [a] -> Int findSubA fullA subA | length fullA < length subA = -1 @@ -50,8 +63,8 @@ takeR amt fullA = drop (length fullA - amt) fullA dropR :: Int -> [a] -> [a] dropR amt fullA = take (length fullA - amt) fullA -combineTuple :: a -> ([a], [a]) -> [a] -combineTuple val tup = fst tup <> [val] <> snd tup +absNum :: Integral a => a -> [b] -> Int +absNum rawNum lst = abs (fromIntegral rawNum) `mod` length lst notEmptyStack :: State -> Lens' State [a] -> Bool notEmptyStack state accessor = not . null $ view accessor state diff --git a/src/Instructions/StringInstructions.hs b/src/Instructions/StringInstructions.hs index 2dbbd63..171007c 100644 --- a/src/Instructions/StringInstructions.hs +++ b/src/Instructions/StringInstructions.hs @@ -3,12 +3,25 @@ module Instructions.StringInstructions where import State import Instructions.GenericInstructions import Data.List.Split +import Control.Lens -absNum :: Integral a => a -> [b] -> Int -absNum rawNum lst = abs (fromIntegral rawNum) `mod` length lst +-- shamelessly stolen from https://hackage.haskell.org/package/MissingH-1.6.0.1/docs/src/Data.String.Utils.html#strip +wschars :: String +wschars = " \t\r\n" -combineString :: String -> (String, String) -> String -combineString toInsert (front, back) = front <> toInsert <> back +strip :: String -> String +strip = lstrip . rstrip + +lstrip :: String -> String +lstrip s = case s of + [] -> [] + (x:xs) -> if x `elem` wschars + then lstrip xs + else s + +-- this is a tad inefficient init +rstrip :: String -> String +rstrip = reverse . lstrip . reverse instructionStringConcat :: State -> State instructionStringConcat state = instructionConcat state string @@ -17,7 +30,7 @@ instructionStringSwap :: State -> State instructionStringSwap state = instructionSwap state string instructionStringInsertString :: State -> State -instructionStringInsertString state@(State{_string = s1 : s2 : ss, _int = i1 : is}) = state {_string = combineString s2 (splitAt i1 s1) : ss, _int = is} +instructionStringInsertString state@(State{_string = s1 : s2 : ss, _int = i1 : is}) = state {_string = combineTupleList s2 (splitAt i1 s1) : ss, _int = is} instructionStringInsertString state = state instructionStringFromFirstChar :: State -> State @@ -35,9 +48,6 @@ instructionStringFromNthChar :: State -> State instructionStringFromNthChar state@(State {_string = s1 : ss, _int = i1 : is}) = state{_string = [s1 !! absNum i1 s1] : ss, _int = is} instructionStringFromNthChar state = state --- instructionStringContainsString :: State -> State --- instructionStringContainsString state@(State ) - instructionStringIndexOfString :: State -> State instructionStringIndexOfString state@(State {_string = s1 : s2 : ss, _int = is}) = state {_string = ss, _int = findSubA s1 s2 : is} instructionStringIndexOfString state = state @@ -80,7 +90,7 @@ instructionStringOccurrencesOfString state@(State {_string = s1 : s2 : ss, _int instructionStringOccurrencesOfString state = state instructionStringInsertChar :: State -> State -instructionStringInsertChar state@(State {_string = s1 : ss, _char = c1 : cs, _int = i1 : is}) = state{_string = combineString [c1] (splitAt i1 s1) : ss, _char = cs, _int = is} +instructionStringInsertChar state@(State {_string = s1 : ss, _char = c1 : cs, _int = i1 : is}) = state{_string = combineTuple c1 (splitAt i1 s1) : ss, _char = cs, _int = is} instructionStringInsertChar state = state instructionStringContainsChar :: State -> State @@ -172,3 +182,31 @@ instructionStringIsEmptyString state = state instructionStringRemoveNth :: State -> State instructionStringRemoveNth state@(State {_string = s1 : ss, _int = i1 : is}) = state{_string = deleteAt (absNum i1 s1) s1 : ss, _int = is} instructionStringRemoveNth state = state + +instructionStringSetNth :: State -> State +instructionStringSetNth state@(State {_string = s1 : ss, _char = c1 : cs, _int = i1 : is}) = state{_string = replaceAt (absNum i1 s1) c1 s1 : ss, _char = cs, _int = is} +instructionStringSetNth state = state + +instructionStringStripWhitespace :: State -> State +instructionStringStripWhitespace state@(State {_string = s1 : ss}) = state{_string = strip s1 : ss} +instructionStringStripWhitespace state = state + +-- Need to do uncons to all of the warnings in this mug +instructionStringFromLens :: Show a => State -> Lens' State [a] -> State +instructionStringFromLens state@(State {_string = ss}) accessor = + case uncons (view accessor state) of + Nothing -> state + Just (x,_) -> state{_string = show x : ss} + +instructionStringFromBool :: State -> State +instructionStringFromBool state = instructionStringFromLens state bool + +instructionStringFromInt :: State -> State +instructionStringFromInt state = instructionStringFromLens state int + +instructionStringFromFloat :: State -> State +instructionStringFromFloat state = instructionStringFromLens state float + +instructionStringFromChar :: State -> State +instructionStringFromChar state@(State {_string = ss, _char = c1 : cs}) = state{_string = [c1] : ss, _char = cs} +instructionStringFromChar state = state