From 363425b39b8c5ac39eeca7db7f3cfb97fcec7659 Mon Sep 17 00:00:00 2001 From: Rowan Torbitzky-Lane Date: Tue, 28 Jan 2025 22:09:30 -0600 Subject: [PATCH] a lot of genericization and updates --- src/Instructions/CharInstructions.hs | 24 +-- src/Instructions/GenericInstructions.hs | 172 ++++++++++++++++++---- src/Instructions/StringInstructions.hs | 39 ++--- src/Instructions/VectorIntInstructions.hs | 48 ++++++ src/LearnLens.hs | 30 ++++ src/Push.hs | 2 - test/Main.hs | 37 ++++- 7 files changed, 275 insertions(+), 77 deletions(-) create mode 100644 src/LearnLens.hs diff --git a/src/Instructions/CharInstructions.hs b/src/Instructions/CharInstructions.hs index 714272c..7d4d94d 100644 --- a/src/Instructions/CharInstructions.hs +++ b/src/Instructions/CharInstructions.hs @@ -2,11 +2,10 @@ module Instructions.CharInstructions where import Data.Char import State -import Data.List (uncons) --- import Instructions.GenericInstructions import Instructions.StringInstructions (wschars) +import Instructions.GenericInstructions -intToAscii :: (Integral a) => a -> Char +intToAscii :: Integral a => a -> Char intToAscii val = chr (abs (fromIntegral val) `mod` 128) instructionCharConcat :: State -> State @@ -14,26 +13,13 @@ instructionCharConcat state@(State {_char = c1 : c2 : cs, _string = ss}) = state instructionCharConcat state = state instructionCharFromFirstChar :: State -> State -instructionCharFromFirstChar state@(State {_char = cs, _string = s1 : ss}) = - case uncons s1 of - Nothing -> state - Just (x,_) -> state {_char = x : cs, _string = ss} -instructionCharFromFirstChar state = state +instructionCharFromFirstChar state = instructionVectorFirst state char string instructionCharFromLastChar :: State -> State -instructionCharFromLastChar state@(State {_char = cs, _string = s1 : ss}) = - if not $ null s1 - then state {_char = last s1 : cs, _string = ss} - else state -instructionCharFromLastChar state = state +instructionCharFromLastChar state = instructionVectorLast state char string instructionCharFromNthChar :: State -> State -instructionCharFromNthChar state@(State {_char = cs, _string = s1 : ss, _int = i1 : is}) = - let - index = abs i1 `mod` length s1 - in - state{_char = s1 !! index : cs, _string = ss, _int = is} -instructionCharFromNthChar state = state +instructionCharFromNthChar state = instructionVectorNth state char string instructionCharIsWhitespace :: State -> State instructionCharIsWhitespace state@(State {_char = c1 : cs, _bool = bs}) = state{_char = cs, _bool = (c1 `elem` wschars) : bs} diff --git a/src/Instructions/GenericInstructions.hs b/src/Instructions/GenericInstructions.hs index 44b6826..73ed59d 100644 --- a/src/Instructions/GenericInstructions.hs +++ b/src/Instructions/GenericInstructions.hs @@ -20,6 +20,15 @@ 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) +subList :: Int -> Int -> [a] -> [a] +subList idx0 idx1 xs = + let + (start, end) = if idx0 <= idx1 then (idx0, idx1) else (idx1, idx0) + adjStart = max 0 start + adjEnd = min end (length xs) + in + take adjEnd (drop adjStart xs) + findSubA :: forall a. Eq a => [a] -> [a] -> Int findSubA fullA subA | length fullA < length subA = -1 @@ -62,13 +71,16 @@ takeR amt fullA = drop (length fullA - amt) fullA dropR :: Int -> [a] -> [a] dropR amt fullA = take (length fullA - amt) fullA +safeInit :: [a] -> [a] +safeInit [] = [] +safeInit xs = init xs + 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 --- This head error should never happen instructionDup :: State -> Lens' State [a] -> State instructionDup state accessor = case uncons (view accessor state) of @@ -83,26 +95,24 @@ instructionPop state accessor = state & accessor .~ drop 1 (view accessor state) -- I might be able to move some of the int stack error checking -- to the integer call. For now this may be a tad inefficient. -instructionDupN :: State -> Lens' State [a] -> State +instructionDupN :: forall a. State -> Lens' State [a] -> State instructionDupN state accessor = - if notEmptyStack state accessor - then - case uncons (view int state) of - Just (i1,_) -> instructionDupNHelper i1 accessor (instructionPop state int) - _ -> state - else state + case uncons (view int state) of + Just (i1,is) -> + case uncons (view accessor state{_int = is}) of + Just (a1,as) -> instructionDupNHelper i1 a1 accessor (state{_int = is} & accessor .~ as) + _ -> state + _ -> state where - instructionDupNHelper :: Int -> Lens' State [a] -> State -> State - instructionDupNHelper count internalAccessor internalState = - if count > 1 && notEmptyStack internalState int - then instructionDupNHelper (count - 1) internalAccessor (instructionDup internalState accessor) + instructionDupNHelper :: Int -> a -> Lens' State [a] -> State -> State + instructionDupNHelper count instruction internalAccessor internalState = + if count > 0 + then instructionDupNHelper (count - 1) instruction internalAccessor (internalState & accessor .~ (instruction : view accessor internalState)) else internalState instructionSwap :: State -> Lens' State [a] -> State instructionSwap state accessor = - if (length . take 2 $ view accessor state) == 2 - then state & accessor .~ swapper (view accessor state) - else state + state & accessor .~ swapper (view accessor state) where swapper :: [a] -> [a] swapper (x1 : x2 : xs) = x2 : x1 : xs @@ -113,9 +123,7 @@ instructionSwap state accessor = -- an instruction later. Template haskell seems very complicated tho. instructionRot :: State -> Lens' State [a] -> State instructionRot state accessor = - if (length . take 3 $ view accessor state) == 3 - then state & accessor .~ rotator (view accessor state) - else state + state & accessor .~ rotator (view accessor state) where rotator :: [a] -> [a] rotator (x1 : x2 : x3 : xs) = x3 : x1 : x2 : xs @@ -126,20 +134,17 @@ 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 - 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 + case uncons stackTop of + Nothing -> state + Just (x1, x2 : _) -> state & bool .~ (x1 == x2) : view bool state & accessor .~ drop 2 (view accessor state) + Just _ -> state where stackTop :: [a] stackTop = take 2 $ view accessor state instructionStackDepth :: State -> Lens' State [a] -> State -instructionStackDepth state accessor = state & int .~ (length (view accessor state) : view int state) +-- instructionStackDepth state accessor = state & int .~ (length (view accessor state) : view int state) +instructionStackDepth state@(State {_int = is}) accessor = state{_int = length (view accessor state) : is} -- Will have a non-generic definition for the int stack instructionYankDup :: State -> Lens' State [a] -> State @@ -190,3 +195,116 @@ instructionConcat state accessor = -- evolve fodder??????????? instructionNoOp :: State -> State instructionNoOp state = state + +instructionConj :: State -> Lens' State [a] -> Lens' State [[a]] -> State +instructionConj state primAccessor vectorAccessor = + case (uncons (view primAccessor state), uncons (view vectorAccessor state)) of + (Just (p1,ps), Just (v1,vs)) -> state & primAccessor .~ ps & vectorAccessor .~ ((p1 : v1) : vs) + _ -> state + +-- v for vector, vs for vectorstack (also applicable to strings) +-- Could abstract this unconsing even further +instructionTakeN :: State -> Lens' State [[a]] -> State +instructionTakeN state@(State {_int = i1 : is}) accessor = + case uncons (view accessor state) of + Just (v1, vs) -> state{_int = is} & accessor .~ (take (absNum i1 v1) v1 : vs) + _ -> state +instructionTakeN state _ = state + +instructionSubVector :: State -> Lens' State [[a]] -> State +instructionSubVector state@(State {_int = i1 : i2 : is}) accessor = + case uncons (view accessor state) of + Just (v1, vs) -> state{_int = is} & accessor .~ (subList i1 i2 v1 : vs) + _ -> state +instructionSubVector state _ = state + +instructionVectorFirst :: State -> Lens' State [a] -> Lens' State [[a]] -> State +instructionVectorFirst state primAccessor vectorAccessor = + case uncons (view vectorAccessor state) of + Just (v1, vs) -> + case uncons v1 of + Just (vp1, _) -> state & primAccessor .~ (vp1 : view primAccessor state) & vectorAccessor .~ vs + _ -> state + _ -> state + +instructionVectorLast :: State -> Lens' State [a] -> Lens' State [[a]] -> State +instructionVectorLast state primAccessor vectorAccessor = + case uncons (view vectorAccessor state) of + Just (v1, vs) -> + case uncons (drop (length v1 - 1) v1) of -- gonna keep this implementation over using last as this can't error + Just (vplast, _) -> state & primAccessor .~ (vplast : view primAccessor state) & vectorAccessor .~ vs + _ -> state + _ -> state + +instructionVectorNth :: State -> Lens' State [a] -> Lens' State [[a]] -> State +instructionVectorNth state@(State {_int = i1 : is}) primAccessor vectorAccessor = + case uncons (view vectorAccessor state) of + Just (v1, vs) -> state{_int = is} & primAccessor .~ (v1 !! absNum i1 v1 : view primAccessor state{_int = is}) & vectorAccessor .~ vs + _ -> state +instructionVectorNth state _ _ = state + +instructionRest :: State -> Lens' State [[a]] -> State +instructionRest state accessor = + case uncons (view accessor state) of + Just (v1, vs) -> state & accessor .~ (drop 1 v1 : vs) + _ -> state + +instructionButLast :: State -> Lens' State [[a]] -> State +instructionButLast state accessor = + case uncons (view accessor state) of + Just (v1, vs) -> state & accessor .~ (safeInit v1 : vs) + _ -> state + +instructionLength :: State -> Lens' State [[a]] -> State +instructionLength state@(State {_int = is}) accessor = + case uncons (view accessor state) of + Just (v1, vs) -> state{_int = length v1 : is} & accessor .~ vs + _ -> state + +instructionReverse :: State -> Lens' State [[a]] -> State +instructionReverse state accessor = + case uncons (view accessor state) of + Just (v1, vs) -> state & accessor .~ (reverse v1 : vs) + _ -> state + +instructionPushAll :: State -> Lens' State [a] -> Lens' State [[a]] -> State +instructionPushAll state primAccessor vectorAccessor = + case uncons (view vectorAccessor state) of + Just (v1, vs) -> state & vectorAccessor .~ vs & primAccessor .~ (v1 <> view primAccessor state) + _ -> state + +instructionVectorMakeEmpty :: State -> Lens' State [[a]] -> State +instructionVectorMakeEmpty state accessor = state & accessor .~ ([] : view accessor state) + +instructionVectorIsEmpty :: State -> Lens' State [[a]] -> State +instructionVectorIsEmpty state@(State {_bool = bs}) accessor = + case uncons (view accessor state) of + Just (v1, vs) -> state{_bool = null v1 : bs} & accessor .~ vs + _ -> state + +instructionVectorContains :: Eq a => State -> Lens' State [a] -> Lens' State [[a]] -> State +instructionVectorContains state@(State {_bool = bs}) primAccessor vectorAccessor = + case (uncons (view vectorAccessor state), uncons (view primAccessor state)) of + (Just (v1, vs), Just (p1, ps)) -> state{_bool = (findSubA v1 [p1] /= -1) : bs} & vectorAccessor .~ vs & primAccessor .~ ps + _ -> state + +-- I couldn't think of a better way of doing this +instructionVectorIndexOf :: Eq a => State -> Lens' State [a] -> Lens' State [[a]] -> State +instructionVectorIndexOf state primAccessor vectorAccessor = + case (uncons (view vectorAccessor state), uncons (view primAccessor state)) of + (Just (v1, vs), Just (p1, ps)) -> (state & vectorAccessor .~ vs & primAccessor .~ ps) & int .~ (findSubA v1 [p1] : view int (state & vectorAccessor .~ vs & primAccessor .~ ps)) + _ -> state + +instructionVectorOccurrencesOf :: Eq a => State -> Lens' State [a] -> Lens' State [[a]] -> State +instructionVectorOccurrencesOf state primAccessor vectorAccessor = + case (uncons (view vectorAccessor state), uncons (view primAccessor state)) of + (Just (v1, vs), Just (p1, ps)) -> (state & vectorAccessor .~ vs & primAccessor .~ ps) & int .~ (amtOccurences v1 [p1] : view int (state & vectorAccessor .~ vs & primAccessor .~ ps)) + _ -> state + +instructionVectorSetNth :: State -> Lens' State [a] -> Lens' State [[a]] -> State +instructionVectorSetNth state@(State {_int = i1 : is}) primAccessor vectorAccessor = + case (uncons (view vectorAccessor state{_int = is}), uncons (view primAccessor state{_int = is})) of + (Just (v1, vs), Just (p1, ps)) -> state{_int = is} & vectorAccessor .~ (replaceAt (absNum i1 v1) p1 v1 : vs) & primAccessor .~ ps + _ -> state +instructionVectorSetNth state _ _ = state + diff --git a/src/Instructions/StringInstructions.hs b/src/Instructions/StringInstructions.hs index 171007c..ceb47db 100644 --- a/src/Instructions/StringInstructions.hs +++ b/src/Instructions/StringInstructions.hs @@ -94,12 +94,12 @@ instructionStringInsertChar state@(State {_string = s1 : ss, _char = c1 : cs, _i instructionStringInsertChar state = state instructionStringContainsChar :: State -> State -instructionStringContainsChar state@(State {_string = s1 : ss, _char = c1 : cs, _bool = bs}) = state{_string = ss, _char = cs, _bool = (findSubA s1 [c1] /= -1) : bs} -instructionStringContainsChar state = state +-- instructionStringContainsChar state@(State {_string = s1 : ss, _char = c1 : cs, _bool = bs}) = state{_string = ss, _char = cs, _bool = (findSubA s1 [c1] /= -1) : bs} +-- instructionStringContainsChar state = state +instructionStringContainsChar state = instructionVectorContains state char string instructionStringIndexOfChar :: State -> State -instructionStringIndexOfChar state@(State {_string = s1 : ss, _char = c1 : cs, _int = is}) = state{_string = ss, _char = cs, _int = findSubA s1 [c1] : is} -instructionStringIndexOfChar state = state +instructionStringIndexOfChar state = instructionVectorIndexOf state char string instructionStringSplitOnChar :: State -> State instructionStringSplitOnChar state@(State {_string = s1 : ss, _char = c1 : cs}) = state {_string = reverse $ splitOn [c1] s1 <> ss, _char = cs} @@ -130,35 +130,26 @@ instructionStringRemoveAllChar state@(State {_string = s1 : ss, _char = c1 : cs} instructionStringRemoveAllChar state = state instructionStringOccurrencesOfChar :: State -> State -instructionStringOccurrencesOfChar state@(State {_string = s1 : ss, _char = c1 : cs, _int = is}) = state{_string = ss, _char = cs, _int = amtOccurences s1 [c1] : is} -instructionStringOccurrencesOfChar state = state +instructionStringOccurrencesOfChar state = instructionVectorOccurrencesOf state char string instructionStringReverse :: State -> State -instructionStringReverse state@(State {_string = s1 : ss}) = state{_string = reverse s1 : ss} -instructionStringReverse state = state +instructionStringReverse state = instructionReverse state string instructionStringHead :: State -> State -instructionStringHead state@(State {_string = s1 : ss, _int = i1 : is}) = state{_string = take (absNum i1 s1) s1 : ss, _int = is} -instructionStringHead state = state +instructionStringHead state = instructionTakeN state string instructionStringTail :: State -> State instructionStringTail state@(State {_string = s1 : ss, _int = i1 : is}) = state{_string = takeR (absNum i1 s1) s1 : ss, _int = is} instructionStringTail state = state instructionStringAppendChar :: State -> State -instructionStringAppendChar state@(State {_string = s1 : ss, _char = c1 : cs}) = state{_string = (c1 : s1) : ss, _char = cs} -instructionStringAppendChar state = state +instructionStringAppendChar state = instructionConj state char string instructionStringRest :: State -> State -instructionStringRest state@(State {_string = s1 : ss}) = state{_string = drop 1 s1 : ss} -instructionStringRest state = state +instructionStringRest state = instructionRest state string instructionStringButLast :: State -> State -instructionStringButLast state@(State {_string = s1 : ss}) = - if not $ null s1 - then state{_string = init s1 : ss} - else state -instructionStringButLast state = state +instructionStringButLast state = instructionButLast state string instructionStringDrop :: State -> State instructionStringDrop state@(State {_string = s1 : ss, _int = i1 : is}) = state{_string = drop (absNum i1 s1) s1 : ss, _int = is} @@ -169,11 +160,10 @@ instructionStringButLastN state@(State {_string = s1 : ss, _int = i1 : is}) = st instructionStringButLastN state = state instructionStringLength :: State -> State -instructionStringLength state@(State {_string = s1 : ss, _int = is}) = state{_string = ss, _int = length s1 : is} -instructionStringLength state = state +instructionStringLength state = instructionLength state string instructionStringMakeEmpty :: State -> State -instructionStringMakeEmpty state@(State {_string = ss}) = state{_string = "" : ss} +instructionStringMakeEmpty state = instructionVectorMakeEmpty state string instructionStringIsEmptyString :: State -> State instructionStringIsEmptyString state@(State {_string = s1 : ss, _bool = bs}) = state{_string = ss, _bool = null s1 : bs} @@ -184,8 +174,9 @@ instructionStringRemoveNth state@(State {_string = s1 : ss, _int = i1 : is}) = s 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 +-- 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 +instructionStringSetNth state = instructionVectorSetNth state char string instructionStringStripWhitespace :: State -> State instructionStringStripWhitespace state@(State {_string = s1 : ss}) = state{_string = strip s1 : ss} diff --git a/src/Instructions/VectorIntInstructions.hs b/src/Instructions/VectorIntInstructions.hs index 1a07d44..b8caf0c 100644 --- a/src/Instructions/VectorIntInstructions.hs +++ b/src/Instructions/VectorIntInstructions.hs @@ -5,3 +5,51 @@ import State instructionIntVectorConcat :: State -> State instructionIntVectorConcat state = instructionConcat state intVector + +instructionIntVectorConj :: State -> State +instructionIntVectorConj state = instructionConj state int intVector + +instructionIntVectorTakeN :: State -> State +instructionIntVectorTakeN state = instructionTakeN state intVector + +instructionIntVectorSubVector :: State -> State +instructionIntVectorSubVector state = instructionSubVector state intVector + +instructionIntVectorFirst :: State -> State +instructionIntVectorFirst state = instructionVectorFirst state int intVector + +instructionIntVectorLast :: State -> State +instructionIntVectorLast state = instructionVectorLast state int intVector + +instructionIntVectorNth :: State -> State +instructionIntVectorNth state = instructionVectorNth state int intVector + +instructionIntVectorRest :: State -> State +instructionIntVectorRest state = instructionRest state intVector + +instructionIntVectorButLast :: State -> State +instructionIntVectorButLast state = instructionButLast state intVector + +instructionIntVectorLength :: State -> State +instructionIntVectorLength state = instructionLength state intVector + +instructionIntVectorReverse :: State -> State +instructionIntVectorReverse state = instructionReverse state intVector + +instructionIntVectorPushAll :: State -> State +instructionIntVectorPushAll state = instructionPushAll state int intVector + +instructionIntVectorMakeEmpty :: State -> State +instructionIntVectorMakeEmpty state = instructionVectorMakeEmpty state intVector + +instructionIntVectorIsEmpty :: State -> State +instructionIntVectorIsEmpty state = instructionVectorIsEmpty state intVector + +instructionIntVectorIndexOf :: State -> State +instructionIntVectorIndexOf state = instructionVectorIndexOf state int intVector + +instructionIntVectorOccurrencesOf :: State -> State +instructionIntVectorOccurrencesOf state = instructionVectorOccurrencesOf state int intVector + +instructionIntVectorSetNth :: State -> State +instructionIntVectorSetNth state = instructionVectorSetNth state int intVector diff --git a/src/LearnLens.hs b/src/LearnLens.hs new file mode 100644 index 0000000..fedd2ab --- /dev/null +++ b/src/LearnLens.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE TemplateHaskell #-} + +module LearnLens where + +import Control.Lens hiding (element) +import Control.Lens.TH + +data Atom = Atom {_element :: String, _point :: Point} deriving (Show) + +data Point = Point {_x :: Double, _Y :: Double} deriving (Show) + +$(makeLenses ''Atom) +$(makeLenses ''Point) + +myAtom :: Atom +myAtom = Atom "climberite" (Point 4.0 3.2) + +shiftAtom :: Atom -> Atom +shiftAtom = over (point . x) (+ 1) + +data Molecule = Molecule {_atoms :: [Atom]} deriving (Show) + +$(makeLenses ''Molecule) + +shiftMolecule :: Molecule -> Molecule +shiftMolecule = over (atoms . traverse . point . x) (+ 1) + +-- Example without template haskell +defPoint :: Lens' Atom Point +defPoint = lens _point (\atom newPoint -> atom {_point = newPoint}) diff --git a/src/Push.hs b/src/Push.hs index 70e8d9a..879b6ca 100644 --- a/src/Push.hs +++ b/src/Push.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE RecordWildCards #-} - module Push where import Control.Lens diff --git a/test/Main.hs b/test/Main.hs index e8c74cd..92afc36 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -11,9 +11,8 @@ import State -- import Debug.Trace --- @TODO: Finish int and float tests - -- TODO: Need a function that can compare states. +-- May look at quickCheck later intTestFunc :: String -> [Int] -> [Gene] -> State -> IO () intTestFunc name goal genome startState = @@ -61,7 +60,8 @@ main = do intTestFunc "instructionIntMod" [3] [GeneInt 13, GeneInt 5, StateFunc instructionIntMod] emptyState intTestFunc "instructionIntPop" [2] [GeneInt 2, GeneInt 0, StateFunc instructionIntPop] emptyState intTestFunc "instructionIntDup" [3, 3, 2] [GeneInt 2, GeneInt 3, StateFunc instructionIntDup] emptyState - intTestFunc "instructionIntDupN" [2, 2, 2] [GeneInt 2, GeneInt 3, StateFunc instructionIntDupN] emptyState + intTestFunc "instructionIntDupN3" [2, 2, 2] [GeneInt 2, GeneInt 3, StateFunc instructionIntDupN] emptyState + intTestFunc "instructionIntDupN-1" [0] [GeneInt 0, GeneInt 2, GeneInt (-1), StateFunc instructionIntDupN] emptyState intTestFunc "instructionIntSwap" [2, 0, 3] [GeneInt 3, GeneInt 2, GeneInt 0, StateFunc instructionIntSwap] emptyState intTestFunc "instructionIntSwapFail" [1] [GeneInt 1, StateFunc instructionIntSwap] emptyState intTestFunc "instructionIntRot" [1, 3, 2] [GeneInt 1, GeneInt 2, GeneInt 3, StateFunc instructionIntRot] emptyState @@ -96,8 +96,10 @@ main = do floatTestFunc "instructionFloatYankDup" [1.1, 4.4, 3.3, 2.2, 1.1] [GeneInt 3, GeneFloat 1.1, GeneFloat 2.2, GeneFloat 3.3, GeneFloat 4.4, StateFunc instructionFloatYankDup] emptyState floatTestFunc "instructionFloatShove" [3.3, 2.2, 4.4, 1.1] [GeneInt 3, GeneFloat 1.1, GeneFloat 2.2, GeneFloat 3.3, GeneFloat 4.4, StateFunc instructionFloatShove] emptyState floatTestFunc "instructionFloatShoveDup" [4.4, 3.3, 2.2, 4.4, 1.1] [GeneInt 3, GeneFloat 1.1, GeneFloat 2.2, GeneFloat 3.3, GeneFloat 4.4, StateFunc instructionFloatShoveDup] emptyState - - -- Bool tests + floatTestFunc "instructionFloatDupNonEmpty" [4.4, 4.4, 3.3] [GeneFloat 3.3, GeneFloat 4.4, StateFunc instructionFloatDup] emptyState + floatTestFunc "instructionFloatDupEmpty" [] [StateFunc instructionFloatDup] emptyState + floatTestFunc "instructionFloatDupN3" [4.4, 4.4, 4.4, 3.3] [GeneFloat 3.3, GeneFloat 4.4, GeneInt 3, StateFunc instructionFloatDupN] emptyState + floatTestFunc "instructionFloatDupN-1" [3.3] [GeneFloat 3.3, GeneFloat 4.4, GeneInt (-1), StateFunc instructionFloatDupN] emptyState boolTestFunc "instructionIntEqTrue" [True] [GeneInt 3, GeneInt 3, StateFunc instructionIntEq] emptyState boolTestFunc "instructionIntEqFalse" [False] [GeneInt 3, GeneInt 5, StateFunc instructionIntEq] emptyState boolTestFunc "instructionIntEqFail" [] [GeneInt 3, StateFunc instructionIntEq] emptyState @@ -256,3 +258,28 @@ main = do -- vector int instructions intVectorTestFunc "instructionIntVectorConcat" [[4, 5, 6, 1, 2, 3]] [GeneIntVector [1, 2, 3], GeneIntVector [4, 5, 6], StateFunc instructionIntVectorConcat] emptyState + intVectorTestFunc "instructionIntVectorConj" [[99, 1, 2, 3]] [GeneIntVector [1, 2, 3], GeneInt 99, StateFunc instructionIntVectorConj] emptyState + intVectorTestFunc "instructionIntTakeN" [[1, 2], [6, 7, 8]] [GeneIntVector [6, 7, 8], GeneIntVector [1, 2, 3], GeneInt 2, StateFunc instructionIntVectorTakeN] emptyState + intVectorTestFunc "instructionIntVectorSubVector" [[1, 2, 3]] [GeneIntVector [0, 1, 2, 3, 4, 5], GeneInt 3, GeneInt 1, StateFunc instructionIntVectorSubVector] emptyState + intTestFunc "instructionIntVectorFirst" [1] [GeneIntVector [1,2,3,4,5], StateFunc instructionIntVectorFirst] emptyState + intTestFunc "instructionIntVectorLast" [5] [GeneIntVector [1,2,3,4,5], StateFunc instructionIntVectorLast] emptyState + intTestFunc "instructionIntVectorNthInBounds" [2] [GeneIntVector [1,2,3,4,5], GeneInt 1, StateFunc instructionIntVectorNth] emptyState + intTestFunc "instructionIntVectorNthOverflow" [2] [GeneIntVector [1,2,3,4,5], GeneInt 6, StateFunc instructionIntVectorNth] emptyState + intVectorTestFunc "instructionIntVectorRestFull" [[2,3,4,5]] [GeneIntVector [1,2,3,4,5], StateFunc instructionIntVectorRest] emptyState + intVectorTestFunc "instructionIntVectorRestEmpty" [[]] [GeneIntVector [], StateFunc instructionIntVectorRest] emptyState + intVectorTestFunc "instructionIntVectorButLastFull" [[1,2,3,4]] [GeneIntVector [1,2,3,4,5], StateFunc instructionIntVectorButLast] emptyState + intVectorTestFunc "instructionIntVectorButLastEmpty" [[]] [GeneIntVector [], StateFunc instructionIntVectorButLast] emptyState + intTestFunc "instructionIntVectorLength3" [3] [GeneIntVector [1,2,3], StateFunc instructionIntVectorLength] emptyState + intTestFunc "instructionIntVectorLength0" [0] [GeneIntVector [], StateFunc instructionIntVectorLength] emptyState + intVectorTestFunc "instructionIntVectorReverse" [[4,3,2,1]] [GeneIntVector [1,2,3,4], StateFunc instructionIntVectorReverse] emptyState + intTestFunc "instructionIntVectorPushAllFull" [1,2,3,4,99] [GeneIntVector [1,2,3,4], GeneInt 99, StateFunc instructionIntVectorPushAll] emptyState + intTestFunc "instructionIntVectorPushAllEmpty" [99] [GeneIntVector [], GeneInt 99, StateFunc instructionIntVectorPushAll] emptyState + intVectorTestFunc "instructionIntVectorMakeEmpty" [[]] [StateFunc instructionIntVectorMakeEmpty] emptyState + boolTestFunc "instructionIntVectorIsEmptyTrue" [True] [GeneIntVector [], StateFunc instructionIntVectorIsEmpty] emptyState + boolTestFunc "instructionIntVectorIsEmptyFalse" [False] [GeneIntVector [1,2,3,4], StateFunc instructionIntVectorIsEmpty] emptyState + intTestFunc "instructionIntVectorIndexOf1" [1] [GeneIntVector [1,2,3,4,5], GeneInt 2, StateFunc instructionIntVectorIndexOf] emptyState + intTestFunc "instructionIntVectorIndexOfFail" [-1] [GeneIntVector [], GeneInt 2, StateFunc instructionIntVectorIndexOf] emptyState + intTestFunc "instructionIntVectorOccurrencesOf2" [2] [GeneIntVector [1,2,3,4,2,6,7], GeneInt 2, StateFunc instructionIntVectorOccurrencesOf] emptyState + intTestFunc "instructionIntVectorOccurrencesOf0" [0] [GeneIntVector [1,2,3,4,2,6,7], GeneInt 0, StateFunc instructionIntVectorOccurrencesOf] emptyState + intVectorTestFunc "instructionIntVectorSetNth3" [[0,1,2,99,4,5]] [GeneIntVector [0,1,2,3,4,5], GeneInt 99, GeneInt 3, StateFunc instructionIntVectorSetNth] emptyState + intVectorTestFunc "instructionIntVectorSetNth9" [[0,1,2,99,4,5]] [GeneIntVector [0,1,2,3,4,5], GeneInt 99, GeneInt 9, StateFunc instructionIntVectorSetNth] emptyState