From f613837ddf1916cc7752cb86b208da89d37f020c Mon Sep 17 00:00:00 2001
From: Rowan Torbitzky-Lane <rowan.a.tl@protonmail.com>
Date: Sat, 25 Jan 2025 22:58:23 -0600
Subject: [PATCH] generalization/ more instructions/ etc
---
src/Instructions/CharInstructions.hs | 33 +++++++++++++++
src/Instructions/ExecInstructions.hs | 6 +--
src/Instructions/GenericInstructions.hs | 17 +++++++-
src/Instructions/StringInstructions.hs | 56 +++++++++++++++++++++----
4 files changed, 98 insertions(+), 14 deletions(-)
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