generalization/ more instructions/ etc
This commit is contained in:
parent
0a6a1fc0cb
commit
f613837ddf
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
x
Reference in New Issue
Block a user