more documentation, more to go

This commit is contained in:
Rowan Torbitzky-Lane 2025-02-08 20:57:24 -06:00
parent de18d828a9
commit ebaf1dfc20
6 changed files with 270 additions and 72 deletions

View File

@ -3,36 +3,36 @@ module HushGP.Instructions.BoolInstructions where
import HushGP.State
import HushGP.Instructions.GenericInstructions
-- |If top of int stack /= 0 pushes true to bool stack, else false
-- |If top of int stack /= 0 pushes True to bool stack, else false.
instructionBoolFromInt :: State -> State
instructionBoolFromInt state@(State {_int = i1 : is, _bool = bs}) = state {_int = is, _bool = (i1 /= 0) : bs}
instructionBoolFromInt state = state
-- |If top of float stack /= 0 pushes true to bool stack, else false
-- |If top of float stack /= 0 pushes True to bool stack, else false.
instructionBoolFromFloat :: State -> State
instructionBoolFromFloat state@(State {_float = f1 : fs, _bool = bs}) = state {_float = fs, _bool = (f1 /= 0) : bs}
instructionBoolFromFloat state = state
-- |A template function to make bool comparisons concise
-- |A template function to make bool comparisons concise.
boolTemplate :: (Bool -> Bool -> Bool) -> State -> State
boolTemplate func state@(State {_bool = b1 : b2 : bs}) = state {_bool = func b1 b2 : bs}
boolTemplate _ state = state
-- |Takes the top two bools and ands them
-- |Takes the top two bools and Ands them.
instructionBoolAnd :: State -> State
instructionBoolAnd = boolTemplate (&&)
-- |Takes the top two bools, inverts the first bool and then ands the modified state
-- |Takes the top two bools, inverts the first bool and then Ands the modified state.
instructionBoolInvertFirstThenAnd :: State -> State
instructionBoolInvertFirstThenAnd state@(State {_bool = b1 : bs}) = boolTemplate (&&) state {_bool = not b1 : bs}
instructionBoolInvertFirstThenAnd state = state
-- |Takes the top two bools, inverts the second bool and then ands the modified state
-- |Takes the top two bools, inverts the second bool and then Ands the modified state.
instructionBoolInvertSecondThenAnd :: State -> State
instructionBoolInvertSecondThenAnd state@(State {_bool = b1 : b2 : bs}) = boolTemplate (&&) state {_bool = b1 : not b2 : bs}
instructionBoolInvertSecondThenAnd state = state
-- |Takes the top two bools and ors them
-- |Takes the top two bools and Ors them.
instructionBoolOr :: State -> State
instructionBoolOr = boolTemplate (||)
@ -43,27 +43,27 @@ xor b1 b2
| not b1 && b2 = True
| otherwise = False
-- |Takes the xor of the top two bools
-- |Takes the xor of the top two bools.
instructionBoolXor :: State -> State
instructionBoolXor = boolTemplate xor
-- |Pops the top of the bool stack
-- |Pops the top of the bool stack.
instructionBoolPop :: State -> State
instructionBoolPop = instructionPop bool
-- |Duplicates the top of the bool stack
-- |Duplicates the top of the bool stack.
instructionBoolDup :: State -> State
instructionBoolDup = instructionDup bool
-- |Duplicates the top of the bool stack based on the top int from the int stack
-- |Duplicates the top of the bool stack based on the top int from the int stack.
instructionBoolDupN :: State -> State
instructionBoolDupN = instructionDupN bool
-- |Swaps the top two bools
-- |Swaps the top two bools.
instructionBoolSwap :: State -> State
instructionBoolSwap = instructionSwap bool
-- |Rotates the top three bools
-- |Rotates the top three bools.
instructionBoolRot :: State -> State
instructionBoolRot = instructionRot bool
@ -71,11 +71,11 @@ instructionBoolRot = instructionRot bool
instructionBoolFlush :: State -> State
instructionBoolFlush = instructionFlush bool
-- |Tests if the top two bools are equal and pushes the result to the bool stack
-- |Tests if the top two bools are equal and pushes the result to the bool stack.
instructionBoolEq :: State -> State
instructionBoolEq = instructionEq bool
-- |Calculates the size of a stack and pushes the result to the int stack
-- |Calculates the size of a stack and pushes the result to the int stack.
instructionBoolStackDepth :: State -> State
instructionBoolStackDepth = instructionStackDepth bool
@ -85,24 +85,24 @@ instructionBoolYank :: State -> State
instructionBoolYank = instructionYank bool
-- |Copies an item from deep within the bool stack to the top of the bool stack based on
-- the top int from the int stack
-- the top int from the int stack.
instructionBoolYankDup :: State -> State
instructionBoolYankDup = instructionYankDup bool
-- |Moves an item from the top of the bool stack to deep within the bool stack based on
-- the top int from the int stack
-- the top int from the int stack.
instructionBoolShove :: State -> State
instructionBoolShove = instructionShove bool
-- |Copies an item from the top of the bool stack to deep within the bool stack based on
-- the top int from the int stack
-- the top int from the int stack.
instructionBoolShoveDup :: State -> State
instructionBoolShoveDup = instructionShoveDup bool
-- |If the bool stack is empty, pushes true to bool stack, else false
-- |If the bool stack is empty, pushes True to bool stack, else False.
instructionBoolIsStackEmpty :: State -> State
instructionBoolIsStackEmpty = instructionIsStackEmpty bool
-- |Duplicate the top N items from the bool stack based on the top int from the int stack
-- |Duplicate the top N items from the bool stack based on the top int from the int stack.
instructionBoolDupItems :: State -> State
instructionBoolDupItems = instructionDupItems bool

View File

@ -5,80 +5,80 @@ import HushGP.State
import HushGP.Instructions.StringInstructions (wschars)
import HushGP.Instructions.GenericInstructions
-- |Converts a whole number `mod` 128 to a char
-- |Converts a whole number `mod` 128 to a char.
intToAscii :: Integral a => a -> Char
intToAscii val = chr (abs (fromIntegral val) `mod` 128)
-- |Combines the top two chars into a string and pushes the result to the string stack
-- |Combines the top two chars into a string and pushes the result to the string stack.
instructionCharConcat :: State -> State
instructionCharConcat state@(State {_char = c1 : c2 : cs, _string = ss}) = state{_char = cs, _string = [c1, c2] : ss}
instructionCharConcat state = state
-- |Takes the first char from the top string and pushes it to the char stack.
-- If the string is empty, acts as a no-op
-- If the string is empty, acts as a no-op.
instructionCharFromFirstChar :: State -> State
instructionCharFromFirstChar = instructionVectorFirst char string
-- |Takes the last char from the top string and pushes it to the char stack.
-- If the string is empty, acts as a no-op
-- If the string is empty, acts as a no-op.
instructionCharFromLastChar :: State -> State
instructionCharFromLastChar = instructionVectorLast char string
-- |Takes the Nth char from the top string and pushes it to the char stack
-- based on the top int from the int stack. If the string is empty, acts as a no-op
-- based on the top int from the int stack. If the string is empty, acts as a no-op.
instructionCharFromNthChar :: State -> State
instructionCharFromNthChar = instructionVectorNth char string
-- |Takes the top of the char stack, checks to see if it is whitespace, and then
-- pushes true to the bool stack if so, else false
-- pushes True to the bool stack if so, else false.
instructionCharIsWhitespace :: State -> State
instructionCharIsWhitespace state@(State {_char = c1 : cs, _bool = bs}) = state{_char = cs, _bool = (c1 `elem` wschars) : bs}
instructionCharIsWhitespace state = state
-- |Takes the top of the char stack, checks to see if it is an alphabetic character, and
-- then pushes true to the bool stack if alphabetic, false if not
-- then pushes True to the bool stack if alphabetic, false if not.
instructionCharIsLetter :: State -> State
instructionCharIsLetter state@(State {_char = c1 : cs, _bool = bs}) = state{_char = cs, _bool = isAlpha c1 : bs}
instructionCharIsLetter state = state
-- |Takes the top of the char stack, checks to see if it is a digit, and then pushes true if it is
-- a digit, false if not
-- |Takes the top of the char stack, checks to see if it is a digit, and then pushes True if it is
-- a digit, False if not.
instructionCharIsDigit :: State -> State
instructionCharIsDigit state@(State {_char = c1 : cs, _bool = bs}) = state{_char = cs, _bool = isDigit c1 : bs}
instructionCharIsDigit state = state
-- |Takes the top of the bool stack, pushes 'T' to the char stack if true, 'F' to the char stack if false
-- |Takes the top of the bool stack, pushes 'T' to the char stack if True, 'F' to the char stack if False.
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
-- |Takes the top of the int stack, pushes the ascii representation of the int to the char stack
-- |Takes the top of the int stack, pushes the ascii representation of the int to the char stack.
instructionCharFromAsciiInt :: State -> State
instructionCharFromAsciiInt state@(State {_char = cs, _int = i1 : is}) = state{_char = intToAscii i1 : cs, _int = is}
instructionCharFromAsciiInt state = state
-- |Takes the top of the float stack, pushes the ascii representation of the floored float to the char stack
-- |Takes the top of the float stack, pushes the ascii representation of the floored float to the char stack.
instructionCharFromAsciiFloat :: State -> State
instructionCharFromAsciiFloat state@(State {_char = cs, _float = f1 : fs}) = state{_char = intToAscii @Integer (floor f1) : cs, _float = fs}
instructionCharFromAsciiFloat state = state
-- |Pushes the top string to the char stack split up into individual chars
-- |Pushes the top string to the char stack split up into individual chars.
-- For example: have the string "hello" and the char stack ['a', 'b', 'c'], the char stack
-- looks like ['h', 'e', 'l', 'l', 'o', 'a', 'b', 'c']
-- looks like ['h', 'e', 'l', 'l', 'o', 'a', 'b', 'c'].
instructionCharsFromString :: State -> State
instructionCharsFromString state@(State {_char = cs, _string = s1 : ss}) = state{_char = s1 <> cs, _string = ss}
instructionCharsFromString state = state
-- |Pops the top of the char stack
-- |Pops the top of the char stack.
instructionCharPop :: State -> State
instructionCharPop = instructionPop char
-- |Duplicates the top of the char stack
-- |Duplicates the top of the char stack.
instructionCharDup :: State -> State
instructionCharDup = instructionDup char
-- |Duplicates the top of the char stack N times based on the top of
-- int stack
-- int stack.
instructionCharDupN :: State -> State
instructionCharDupN = instructionDupN char
@ -86,16 +86,16 @@ instructionCharDupN = instructionDupN char
instructionCharSwap :: State -> State
instructionCharSwap = instructionSwap char
-- |Rotates the top three chars of the char stack
-- |Rotates the top three chars of the char stack.
instructionCharRot :: State -> State
instructionCharRot = instructionRot char
-- |Sets the char stack to []
-- |Sets the char stack to [].
instructionCharFlush :: State -> State
instructionCharFlush = instructionFlush char
-- |Checks to see if the top two chars to equal and pushes the result
-- to the bool stack
-- to the bool stack.
instructionCharEq :: State -> State
instructionCharEq = instructionEq char
@ -105,29 +105,29 @@ instructionCharStackDepth :: State -> State
instructionCharStackDepth = instructionStackDepth char
-- |Moves an item from deep within the char stack to the top of the char stack based on
-- the top int from the int stack
-- the top int from the int stack.
instructionCharYank :: State -> State
instructionCharYank = instructionYank char
-- |Copies an item from deep within the char stack to the top of the char stack based on
-- the top int from the int stack
-- the top int from the int stack.
instructionCharYankDup :: State -> State
instructionCharYankDup = instructionYankDup char
-- |Pushes the size of the char stack to the int stack
-- |Pushes True to the bool stack if the char stack is empty. False if not.
instructionCharIsStackEmpty :: State -> State
instructionCharIsStackEmpty = instructionIsStackEmpty char
-- |Moves an item from the top of the char stack to deep within the char stack based on
-- the top int from the int stack
-- the top int from the int stack.
instructionCharShove :: State -> State
instructionCharShove = instructionShove char
-- |Copies an item from the top of the char stack to deep within the char stack based on
-- the top int from the int stack
-- the top int from the int stack.
instructionCharShoveDup :: State -> State
instructionCharShoveDup = instructionShoveDup char
-- |Duplicate the top N items from the char stack based on the top int from the int stack
-- |Duplicate the top N items from the char stack based on the top int from the int stack.
instructionCharDupItems :: State -> State
instructionCharDupItems = instructionDupItems char

View File

@ -45,82 +45,104 @@ countDiscrepancy :: Gene -> Gene -> Int
countDiscrepancy (Block xs) (Block ys) = sum [if uncurry (==) tup then 0 else 1 | tup <- zip xs ys] + abs (length xs - length ys)
countDiscrepancy xgene ygene = if xgene == ygene then 1 else 0
-- |Utility Function: Extracts the first gene from a block. Returns itself if not a block
extractFirstFromBlock :: Gene -> Gene
extractFirstFromBlock (Block (bx1 : _)) = bx1
extractFirstFromBlock gene = gene
-- |Utility Function: Returns the last gene from a block, [] if the block is empty, and itself if not a block
extractLastFromBlock :: Gene -> Gene
extractLastFromBlock (Block []) = Block []
extractLastFromBlock (Block bxs) = last bxs
extractLastFromBlock gene = gene
-- |Utility Function: Calls init on a block. If the block is empty, returns []. If gene isn't a block, returns itself
extractInitFromBlock :: Gene -> Gene
extractInitFromBlock (Block []) = Block []
extractInitFromBlock (Block bxs) = Block (init bxs)
extractInitFromBlock (Block bxs) = Block (safeInit bxs)
extractInitFromBlock gene = gene
-- |Utility Function: Calls `drop 1` on a block. If gene isn't a block, returns itself
extractTailFromBlock :: Gene -> Gene
extractTailFromBlock (Block bxs) = Block (drop 1 bxs)
extractTailFromBlock _ = Block []
-- |Utility Function: Extracts the code at a point in the genome. Recurses into a nested Block if found. The
-- point is based on an int.
codeAtPoint :: [Gene] -> Int -> Gene
codeAtPoint (gene : _) 0 = gene
codeAtPoint [] _ = Block [] -- Should only happen if an empty block is last Gene in the list of Genes
codeAtPoint ((Block nestedGenes) : genes) index = codeAtPoint (nestedGenes <> genes) (index - 1)
codeAtPoint (_ : genes) index = codeAtPoint genes (index - 1)
-- |Utility Function: Inserts code at a point in the genome. Recurses into a block if found. The point is based
-- on an integer
codeInsertAtPoint :: [Gene] -> Gene -> Int -> [Gene]
codeInsertAtPoint oldGenes gene 0 = gene : oldGenes
codeInsertAtPoint [] gene _ = [gene] -- This shouldn't happen (lol)
codeInsertAtPoint ((Block genes) : oldGenes) gene index = Block (codeInsertAtPoint genes gene (index - 1)) : oldGenes
codeInsertAtPoint (oldGene : oldGenes) gene index = oldGene : codeInsertAtPoint oldGenes gene (index - 1)
-- |Utility Function: Combines two genes together into a block.
codeCombine :: Gene -> Gene -> Gene
codeCombine (Block bxs) (Block bys) = Block (bxs <> bys)
codeCombine (Block bxs) ygene = Block (ygene : bxs)
codeCombine xgene (Block bys) = Block (xgene : bys)
codeCombine xgene ygene = Block [xgene, ygene]
-- |Utility Function: Determines if the second gene is a member of the first gene.
-- If the first gene is a Block and the second gene is also a Block, does a sublist search for the second block in the first block.
-- if the first gene is a Block and the second gene is not, the block is searched for the second gene.
-- If neither of the genes are blocks, returns False.
codeMember :: Gene -> Gene -> Bool
codeMember (Block bxs) (Block bys) = findSubA bxs bys /= (-1)
codeMember (Block bxs) ygene = ygene `elem` bxs
codeMember _ _ = False
-- |Utility Function: Calculates the size of a Block including counting the nested Blocks recursively
codeRecursiveSize :: Gene -> Int
codeRecursiveSize (Block bxs) = sum [codeRecursiveSize x + if isBlock x then 1 else 0 | x <- bxs]
codeRecursiveSize _ = 1
-- |Pops the top of the code stack
instructionCodePop :: State -> State
instructionCodePop = instructionPop code
-- |Checks if the top code item is a Block
instructionCodeIsCodeBlock :: State -> State
instructionCodeIsCodeBlock state@(State {_code = c1 : cs, _bool = bs}) = state {_code = cs, _bool = isBlock c1 : bs}
instructionCodeIsCodeBlock state = state
-- |Checks if the top code item is not a Block
instructionCodeIsSingular :: State -> State
instructionCodeIsSingular state@(State {_code = c1 : cs, _bool = bs}) = state {_code = cs, _bool = not (isBlock c1) : bs}
instructionCodeIsSingular state = state
-- |Checks the length of the top code item. If item is a block, counts the size, if not, returns 1
instructionCodeLength :: State -> State
instructionCodeLength state@(State {_code = c1 : cs, _int = is}) = state {_code = cs, _int = blockLength c1 : is}
instructionCodeLength state = state
-- CODE.CAR
-- |If the top item on the code stack is a Block, extracts the first item and places it onto the code stack. Acts as a NoOp otherwise.
instructionCodeFirst :: State -> State
instructionCodeFirst state@(State {_code = c1 : cs}) = state {_code = extractFirstFromBlock c1 : cs}
instructionCodeFirst state = state
-- |If the top item on the code stack is a Block, extracts the last item and places it onto the code stack. Acts as a NoOp otherwise.
instructionCodeLast :: State -> State
instructionCodeLast state@(State {_code = c1 : cs}) = state {_code = extractLastFromBlock c1 : cs}
instructionCodeLast state = state
-- |If the top item on the code stack is a Block, extracts the tail of said Block and places it onto the code stace. Acts as a NoOp otherwise.
-- CODE.CDR
-- https://erp12.github.io/pyshgp/html/core_instructions.html#code-rest
instructionCodeTail :: State -> State
instructionCodeTail state@(State {_code = c1 : cs}) = state {_code = extractTailFromBlock c1 : cs}
instructionCodeTail state = state
-- |Takes the tail of a block starting at an index determined by the int stack
-- |If the top item on the code stack is a Block, takes the tail of said block starting at an index determined by the int stack
-- and pushes the result to the code stack.
-- Acts as a NoOp if not a Block.
-- https://faculty.hampshire.edu/lspector/push3-description.html#Type
-- This is the CODE.NTHCDR command
instructionCodeTailN :: State -> State
@ -130,42 +152,55 @@ instructionCodeTailN state@(State {_code = Block bc : cs, _int = i : is}) = stat
index = abs i `mod` length bc
instructionCodeTailN state = state
-- |If the top item on the code stack is a Block, takes the init of said Block and places the result on top of the code stack.
-- Acts as a NoOp otherwise
-- https://erp12.github.io/pyshgp/html/core_instructions.html#code-but-last
instructionCodeInit :: State -> State
instructionCodeInit state@(State {_code = c1 : cs}) = state {_code = extractInitFromBlock c1 : cs}
instructionCodeInit state = state
-- |Wraps the top item in the code stack in a Block no matter the type.
instructionCodeWrap :: State -> State
instructionCodeWrap state@(State {_code = c1 : cs}) = state {_code = Block [c1] : cs}
instructionCodeWrap state = state
-- |Wraps the top two items in the code stack in a Block no matter the type.
instructionCodeList :: State -> State
instructionCodeList state@(State {_code = c1 : c2 : cs}) = state {_code = Block [c1, c2] : cs}
instructionCodeList state = state
-- |Combines the top two items on the code stack based on whether they are a block or not.
-- Check out the codeCombine utility function for how this works.
instructionCodeCombine :: State -> State
instructionCodeCombine state@(State {_code = c1 : c2 : cs}) = state {_code = codeCombine c1 c2 : cs}
instructionCodeCombine state = state
-- |Moves the top item from the code stack to the exec stack
instructionCodeDo :: State -> State
instructionCodeDo state@(State {_code = c1 : cs, _exec = es}) = state {_code = cs, _exec = c1 : es}
instructionCodeDo state = state
-- |Moves the top item from the code stack to the exec stack, doesn't delete the original item from the code stack.
instructionCodeDoDup :: State -> State
instructionCodeDoDup state@(State {_code = c1 : cs, _exec = es}) = state {_code = c1 : cs, _exec = c1 : es}
instructionCodeDoDup state = state
-- |Places the top code item onto the exec stack (doesn't delete it from the code stack), then places an instructionCodePop onto
-- the exec stack.
-- https://erp12.github.io/pyshgp/html/core_instructions.html#code-do-then-pop
instructionCodeDoThenPop :: State -> State
instructionCodeDoThenPop state@(State {_code = c1 : _, _exec = es}) = state {_exec = c1 : StateFunc (instructionCodePop, "instructionCodePop") : es}
instructionCodeDoThenPop state = state
-- |Utility: A shorthand for instrucitonCodeFromExec to make code instructions less bloated
codeFromExec :: Gene
codeFromExec = StateFunc (instructionCodeFromExec, "instructionCodeFromExec")
-- |Utility: A shorthand for instructionCodoDoRange to make code instructions less bloated
codeDoRange :: Gene
codeDoRange = StateFunc (instructionCodeDoRange, "instructionCodeDoRange")
-- |Evaluates the top item on the code stack for each step along the range i to j. Both i and j are taken from the int stack.
instructionCodeDoRange :: State -> State
instructionCodeDoRange state@(State {_code = c1 : cs, _int = i0 : i1 : is, _exec = es}) =
if increment i0 i1 /= 0
@ -179,6 +214,7 @@ instructionCodeDoRange state@(State {_code = c1 : cs, _int = i0 : i1 : is, _exec
| otherwise = 0
instructionCodeDoRange state = state
-- |Evaluates the top item on the code stack for each step along the range i to j. Both i and j are taken from the int stack.
instructionCodeDoCount :: State -> State
instructionCodeDoCount state@(State {_code = c : cs, _int = i1 : is, _exec = es}) =
if i1 < 1
@ -186,6 +222,7 @@ instructionCodeDoCount state@(State {_code = c : cs, _int = i1 : is, _exec = es}
else state {_code = cs, _int = is, _exec = Block [GeneInt 0, GeneInt $ i1 - 1, codeFromExec, c, codeDoRange] : es}
instructionCodeDoCount state = state
-- |Evaluates the top item on the code stack n times, where n comes from the n comes from the top of the int stack.
instructionCodeDoTimes :: State -> State
instructionCodeDoTimes state@(State {_code = c : cs, _int = i1 : is, _exec = es}) =
if i1 < 1
@ -193,18 +230,23 @@ instructionCodeDoTimes state@(State {_code = c : cs, _int = i1 : is, _exec = es}
else state {_code = cs, _int = is, _exec = Block [GeneInt 0, GeneInt $ i1 - 1, codeFromExec, Block [StateFunc (instructionIntPop, "instructionIntPop"), c], codeDoRange] : es}
instructionCodeDoTimes state = state
-- |If the top boolean is true, execute the top element of the code stack and skip the second. Otherwise, skip the top element of the code stack and execute the second.
instructionCodeIf :: State -> State
instructionCodeIf state@(State {_code = c1 : c2 : cs, _bool = b1 : bs, _exec = es}) = state{_code = cs, _bool = bs, _exec = (if b1 then c1 else c2) : es}
instructionCodeIf state = state
-- |Evalutates the top code item if the top bool is true. Otherwise the top code is popped.
instructionCodeWhen :: State -> State
instructionCodeWhen state@(State {_code = c1 : cs, _bool = b1 : bs, _exec = es}) = state{_code = cs, _bool = bs, _exec = if b1 then c1 : es else es}
instructionCodeWhen state = state
-- |Pushes true to the bool stack if the second to top code item is found within the first code item. Pushes False if not.
instructionCodeMember :: State -> State
instructionCodeMember state@(State {_code = c1 : c2 : cs, _bool = bs}) = state{_code = cs, _bool = codeMember c1 c2 : bs}
instructionCodeMember state = state
-- |Pushes the nth element from a Block onto the code stack based on an index from the int stack.
-- If the top of the code stack is not a block, the int is still eaten.
-- This one doesn't count the recursive Blocks while instructionCodeExtract does
-- https://erp12.github.io/pyshgp/html/core_instructions.html#code-nth
instructionCodeN :: State -> State
@ -218,17 +260,24 @@ instructionCodeN state@(State {_code = (Block c1) : cs, _int = i1 : is}) =
instructionCodeN state@(State {_code = c1 : cs, _int = _ : is}) = state {_code = c1 : cs, _int = is}
instructionCodeN state = state
-- |Makes an empty Block and pushes it to the top of the code stack.
instructionMakeEmptyCodeBlock :: State -> State
instructionMakeEmptyCodeBlock state@(State {_code = cs}) = state {_code = Block [] : cs}
-- |If the top of the code stack is a Block, pushes True to the bool stack if it is and False if it's not.
-- If the top item of the code stack is not a Block, False gets pushed to the bool stack
instructionIsEmptyCodeBlock :: State -> State
instructionIsEmptyCodeBlock state@(State {_code = Block c1 : cs, _bool = bs}) = state{_code = cs, _bool = null c1 : bs}
instructionIsEmptyCodeBlock state@(State {_bool = bs}) = state{_bool = False : bs}
instructionIsEmptyCodeBlock state@(State {_code = _ : cs, _bool = bs}) = state{_code = cs, _bool = False : bs}
instructionIsEmptyCodeBlock state = state
-- |Pushes the size of the top code item to the int stack. If it's a Block, the size is counted recursively. If
-- it's not a Block, 1 gets pushed to the int stack.
instructionCodeSize :: State -> State
instructionCodeSize state@(State {_code = c1 : cs, _int = is}) = state{_code = cs, _int = codeRecursiveSize c1 : is}
instructionCodeSize state = state
-- |Pushes the size of the top code item recursively counting the nested Blocks.
-- There's a bug for this instruction in pysh where the last item in the
-- top level Block isn't counted, and if passed 0, then the entire codeblock is returned.
-- I designed this function differently so 0 returns the 0th element, and the last item
@ -242,6 +291,8 @@ instructionCodeExtract state@(State {_code = block@(Block c1) : cs, _int = i1 :
instructionCodeExtract state@(State {_code = cs, _int = _ : is}) = state{_code = cs, _int = is}
instructionCodeExtract state = state
-- |Inserts a code item into a block recursively entering the nested Blocks if needed based on the top
-- int from the int stack. If the top code item isn't a Block, coerces the top item into a Block.
instructionCodeInsert :: State -> State
instructionCodeInsert state@(State {_code = block@(Block c1) : c2 : cs, _int = i1 : is}) =
let
@ -255,11 +306,13 @@ instructionCodeInsert state@(State {_code = c1 : c2 : cs, _int = i1 : is}) =
state{_code = Block (codeInsertAtPoint [c1] c2 index) : cs, _int = is}
instructionCodeInsert state = state
-- |If the top code item is a Block that is empty, pushes 0 to the int stack if c2 is also an empty Block and -1 if not.
-- If the top code item is a Block that is not empty, pushes the index found of the second code item if found, -1 if not.
-- If neither the top code item or second code item are Blocks, checks equality. If equal, pushes 1 to int stack, pushes 0 if not.
instructionCodeFirstPosition :: State -> State
instructionCodeFirstPosition state@(State {_code = (Block []) : c2 : cs, _int = is}) = state {_code = cs, _int = (if c2 == Block [] then 0 else -1) : is}
instructionCodeFirstPosition state@(State {_code = (Block c1) : c2 : cs, _int = is}) = state {_code = cs, _int = positionElem c1 c2 : is}
where
-- This is really not gonna be good for StateFunc
positionElem :: [Gene] -> Gene -> Int
positionElem genes gene =
case elemIndex gene genes of
@ -268,76 +321,104 @@ instructionCodeFirstPosition state@(State {_code = (Block c1) : c2 : cs, _int =
instructionCodeFirstPosition state@(State {_code = c1 : c2 : cs, _int = is}) = state {_code = cs, _int = (if c1 == c2 then 0 else -1) : is}
instructionCodeFirstPosition state = state
-- |If the top of the code stack is a Block, reverses the elements of the Block. Acts as a NoOp otherwise.
instructionCodeReverse :: State -> State
instructionCodeReverse state@(State {_code = (Block c1) : cs}) = state {_code = Block (reverse c1) : cs}
instructionCodeReverse state = state
-- |Duplicates the top of the code stack.
instructionCodeDup :: State -> State
instructionCodeDup = instructionDup code
-- |Duplicates the top of the code stack N times based on the top int.
instructionCodeDupN :: State -> State
instructionCodeDupN = instructionDupN code
-- |Swaps the top two code items.
instructionCodeSwap :: State -> State
instructionCodeSwap = instructionSwap code
-- |Rotates the top three code items.
instructionCodeRot :: State -> State
instructionCodeRot = instructionRot code
-- |Sets the code stack to []
instructionCodeFlush :: State -> State
instructionCodeFlush = instructionFlush code
-- |Checks if the top code items are equal. Pushes true to the bool stack if so, False if not.
instructionCodeEq :: State -> State
instructionCodeEq = instructionEq code
-- |Pushes the size of the code stack to the int stack.
instructionCodeStackDepth :: State -> State
instructionCodeStackDepth = instructionStackDepth code
-- |Moves an item from deep within the code stack to the top of the code stack based on
-- the top int from the int stack.
instructionCodeYank :: State -> State
instructionCodeYank = instructionYank code
-- |Copies an item from deep within the code stack to the top of the code stack based on
-- the top int from the int stack.
instructionCodeYankDup :: State -> State
instructionCodeYankDup = instructionYankDup code
-- |If the code stack is empty, pushes True to bool stack, else False.
instructionCodeIsStackEmpty :: State -> State
instructionCodeIsStackEmpty = instructionIsStackEmpty code
-- |Moves an item from the top of the code stack to deep within the code stack based on
-- the top int from the int stack.
instructionCodeShove :: State -> State
instructionCodeShove = instructionShove code
-- |Copies an item from the top of the code stack to deep within the code stack based on
-- the top int from the int stack.
instructionCodeShoveDup :: State -> State
instructionCodeShoveDup = instructionShoveDup code
-- |Takes the top bool from the bool stack and places said GeneBool on the code stack.
instructionCodeFromBool :: State -> State
instructionCodeFromBool = instructionCodeFrom bool GeneBool
-- |Takes the top int from the int stack and places said GeneInt on the code stack.
instructionCodeFromInt :: State -> State
instructionCodeFromInt = instructionCodeFrom int GeneInt
-- |Takes the top char from the char stack and places said GeneChar on the code stack.
instructionCodeFromChar :: State -> State
instructionCodeFromChar = instructionCodeFrom char GeneChar
-- |Takes the top float from the float stack and places said GeneFloat on the code stack.
instructionCodeFromFloat :: State -> State
instructionCodeFromFloat = instructionCodeFrom float GeneFloat
-- |Takes the top string from the string stack and places said GeneString on the code stack.
instructionCodeFromString :: State -> State
instructionCodeFromString = instructionCodeFrom string GeneString
-- |Takes the top vectorInt from the vectorInt stack and places said GeneVectorInt on the code stack.
instructionCodeFromVectorInt :: State -> State
instructionCodeFromVectorInt = instructionCodeFrom vectorInt GeneVectorInt
-- |Takes the top vectorFloat from the vectorFloat stack and places said GeneVectorFloat on the code stack.
instructionCodeFromVectorFloat :: State -> State
instructionCodeFromVectorFloat = instructionCodeFrom vectorFloat GeneVectorFloat
-- |Takes the top vectorString from the vectorString stack and places said GeneVectorString on the code stack.
instructionCodeFromVectorString :: State -> State
instructionCodeFromVectorString = instructionCodeFrom vectorString GeneVectorString
-- |Takes the top vectorBool from the vectorBool stack and places said GeneVectorBool on the code stack.
instructionCodeFromVectorBool :: State -> State
instructionCodeFromVectorBool = instructionCodeFrom vectorBool GeneVectorBool
-- |Takes the top vectorChar from the vectorChar stack and places said GeneVectorChar on the code stack.
instructionCodeFromVectorChar :: State -> State
instructionCodeFromVectorChar = instructionCodeFrom vectorChar GeneVectorChar
-- |Takes the top gene from the exec stack and places a gene on the code stack.
instructionCodeFromExec :: State -> State
instructionCodeFromExec = instructionCodeFrom exec id
@ -361,8 +442,10 @@ instructionCodeDiscrepancy :: State -> State
instructionCodeDiscrepancy state@(State {_code = c1 : c2 : cs, _int = is}) = state {_code = cs, _int = countDiscrepancy c1 c2 : is}
instructionCodeDiscrepancy state = state
-- |Just a NoOp
instructionCodeNoOp :: State -> State
instructionCodeNoOp state = state
-- |Duplicates the top N items of the code stack based on the top of the int stack.
instructionCodeDupItems :: State -> State
instructionCodeDupItems = instructionDupItems code

View File

@ -4,6 +4,8 @@ import HushGP.State
import HushGP.Instructions.IntInstructions
import HushGP.Instructions.GenericInstructions
-- |Removes the second item from the exec stack if the top of the bool stack is True.
-- Removes the first item from the exec stack if the top of the bool stack is False.
instructionExecIf :: State -> State
instructionExecIf state@(State {_exec = e1 : e2 : es, _bool = b1 : bs}) =
if b1
@ -11,48 +13,69 @@ instructionExecIf state@(State {_exec = e1 : e2 : es, _bool = b1 : bs}) =
else state {_exec = e2 : es, _bool = bs}
instructionExecIf state = state
-- |Duplicates the top exec instruction (the one after this one on the stack).
instructionExecDup :: State -> State
instructionExecDup = instructionDup exec
-- |Duplicates the top of the exec stack N times based on the top of
-- int stack (the exec instruction after this one).
instructionExecDupN :: State -> State
instructionExecDupN = instructionDupN exec
-- |Pops the top of the exec stack (the one after this on on the stack).
instructionExecPop :: State -> State
instructionExecPop = instructionPop exec
-- |Swaps the top two instructions on the exec stack (the two after this on the exec stack).
instructionExecSwap :: State -> State
instructionExecSwap = instructionSwap exec
-- |Rotates the top three instructions on the exec stack (the three after this on the exec stack).
instructionExecRot :: State -> State
instructionExecRot = instructionRot exec
-- |Sets the exec stack to []. This stops the program.
instructionExecFlush :: State -> State
instructionExecFlush = instructionFlush exec
-- |Checks if the top two exec instructions are True.
instructionExecEq :: State -> State
instructionExecEq = instructionEq exec
-- |Calculates the size of the exec stack and pushes the result to the int stack.
instructionExecStackDepth :: State -> State
instructionExecStackDepth = instructionStackDepth exec
-- |Moves an item from deep within the exec stack to the top of the exec stack based on
-- the top int from the int stack.
instructionExecYank :: State -> State
instructionExecYank = instructionYank exec
-- |Copies an item from deep within the exec stack to the top of the exec stack based on
-- the top int from the int stack.
instructionExecYankDup :: State -> State
instructionExecYankDup = instructionYankDup exec
-- |Moves an item from the top of the shove stack to deep within the shove stack based on
-- the top int from the int stack.
instructionExecShove :: State -> State
instructionExecShove = instructionShove exec
-- |Copies an item from the top of the shove stack to deep within the shove stack based on
-- the top int from the int stack.
instructionExecShoveDup :: State -> State
instructionExecShoveDup = instructionShoveDup exec
-- |If the code stack is empty, pushes True to bool stack, else False.
instructionExecIsStackEmpty :: State -> State
instructionExecIsStackEmpty = instructionIsStackEmpty exec
-- |Utility: Shorthand for instructionExecDoRange
execDoRange :: Gene
execDoRange = StateFunc (instructionExecDoRange, "instructionExecDoRange")
-- |Evaluates the top item on the exec stack for each step along the range i to j. Both i and j are
-- taken from the int stack. Differs from code_do_range only in the source of the code and the recursive call.
instructionExecDoRange :: State -> State
instructionExecDoRange state@(State {_exec = e1 : es, _int = i0 : i1 : is}) =
if increment i0 i1 /= 0
@ -66,6 +89,8 @@ instructionExecDoRange state@(State {_exec = e1 : es, _int = i0 : i1 : is}) =
| otherwise = 0
instructionExecDoRange state = state
-- |Evaluates the top item on the exec stack n times, where n comes from the n comes from the top
-- of the int stack. Differs from code.do*count only in the source of the code and the recursive call.
instructionExecDoCount :: State -> State
instructionExecDoCount state@(State {_exec = e1 : es, _int = i1 : is}) =
if i1 < 1
@ -73,6 +98,7 @@ instructionExecDoCount state@(State {_exec = e1 : es, _int = i1 : is}) =
else state {_exec = Block [GeneInt 0, GeneInt $ i1 - 1, execDoRange, e1] : es, _int = is}
instructionExecDoCount state = state
-- |Evaluates the top item on the code stack n times, where n comes from the n comes from the top of the int stack.
instructionExecDoTimes :: State -> State
instructionExecDoTimes state@(State {_exec = e1 : es, _int = i1 : is}) =
if i1 < 1
@ -80,9 +106,11 @@ instructionExecDoTimes state@(State {_exec = e1 : es, _int = i1 : is}) =
else state {_exec = Block [GeneInt 0, GeneInt $ i1 - 1, execDoRange, Block [StateFunc (instructionIntPop, "instructionIntPop"), e1]] : es, _int = is}
instructionExecDoTimes state = state
-- |Utility: A shorthand for instructionExecWhile
execWhile :: Gene
execWhile = StateFunc (instructionExecWhile, "instructionExecWhile")
-- |Evaluates the top item on the exec stack repeated until the top bool is no longer True.
instructionExecWhile :: State -> State
instructionExecWhile state@(State {_exec = _ : es, _bool = []}) =
state {_exec = es}
@ -92,12 +120,16 @@ instructionExecWhile state@(State {_exec = alles@(e1 : es), _bool = b1 : bs}) =
else state {_exec = es}
instructionExecWhile state = state
-- |Evaluates the top item on the exec stack repeated until the top bool is no longer True.
-- Executes at least once.
instructionExecDoWhile :: State -> State
instructionExecDoWhile state@(State {_exec = alles@(e1 : _)}) =
state {_exec = e1 : execWhile : alles}
instructionExecDoWhile state = state
-- Eats the _boolean no matter what
-- |Pops the next item on the exec stack without evaluating it
-- if the top bool is False. Otherwise, has no effect.
-- Eats the top bool no matter what.
instructionExecWhen :: State -> State
instructionExecWhen state@(State {_exec = _ : es, _bool = b1 : bs}) =
if not b1
@ -105,20 +137,23 @@ instructionExecWhen state@(State {_exec = _ : es, _bool = b1 : bs}) =
else state {_bool = bs}
instructionExecWhen state = state
-- |The K combinator
-- |The K combinator. Deletes the second to top exec item.
instructionExecK :: State -> State
instructionExecK state@(State {_exec = e1 : _ : es}) = state{_exec = e1 : es}
instructionExecK state = state
-- |The S combinator
-- |The S combinator. Takes the top three top exec items, pushes a Block of the second and third instruction,
-- then the third instruction, and then the first instruction.
instructionExecS :: State -> State
instructionExecS state@(State {_exec = e1 : e2 : e3 : es}) = state{_exec = e1 : e3 : Block [e2, e3] : es}
instructionExecS state = state
-- |The Y combinator
-- |The Y combinator. Takes the top exec item. Pushes a Block containing the Y combinator instruction and the top exec item.
-- Then pushes that top exec item again.
instructionExecY :: State -> State
instructionExecY state@(State {_exec = e1 : es}) = state{_exec = e1 : Block [StateFunc (instructionExecY, "instructionExecY"), e1] : es}
instructionExecY state = state
-- |Duplicates the top N items of the exec stack based on the top of the int stack.
instructionExecDupItems :: State -> State
instructionExecDupItems = instructionDupItems exec

View File

@ -5,18 +5,22 @@ import HushGP.Instructions.GenericInstructions
import HushGP.State
import Data.Char
-- |Converts the top int to a float and pushes the result to the float stack.
instructionFloatFromInt :: State -> State
instructionFloatFromInt state@(State {_float = fs, _int = i1 : is}) = state {_float = (fromIntegral i1 :: Float) : fs, _int = is}
instructionFloatFromInt state = state
-- |If the top bool True, pushes 1.0 to the float stack. Pushes 0.0 if False.
instructionFloatFromBool :: State -> State
instructionFloatFromBool state@(State {_bool = b1 : bs, _float = fs}) = state {_bool = bs, _float = (if b1 then 1.0 else 0.0) : fs}
instructionFloatFromBool state = state
-- |Takes the top char and converts it to int representation. That int then gets casted to a float.
instructionFloatFromChar :: State -> State
instructionFloatFromChar state@(State {_char = c1 : cs, _float = fs}) = state {_char = cs, _float = (fromIntegral (ord c1) :: Float) : fs}
instructionFloatFromChar state = state
-- |Reads the top string and converts it to a float if possible. If not, acts as a NoOp.
instructionFloatFromString :: State -> State
instructionFloatFromString state@(State {_string = s1 : ss, _float = fs}) =
if all isDigit s1
@ -24,108 +28,142 @@ instructionFloatFromString state@(State {_string = s1 : ss, _float = fs}) =
else state
instructionFloatFromString state = state
-- |Adds the top two floats from the float stack.
instructionFloatAdd :: State -> State
instructionFloatAdd state@(State {_float = f1 : f2 : fs}) = state {_float = f2 + f1 : fs}
instructionFloatAdd state = state
-- |Subtracts the first float from the second float on the float stack.
instructionFloatSub :: State -> State
instructionFloatSub state@(State {_float = f1 : f2 : fs}) = state {_float = f2 - f1 : fs}
instructionFloatSub state = state
-- |Multiplies the top two floats on the float stack.
instructionFloatMul :: State -> State
instructionFloatMul state@(State {_float = f1 : f2 : fs}) = state {_float = f2 * f1 : fs}
instructionFloatMul state = state
-- |Divides the first float from the second float on the float stack.
instructionFloatDiv :: State -> State
instructionFloatDiv state@(State {_float = f1 : f2 : fs}) = state {_float = if f1 /= 0 then f2 / f1 : fs else f1 : f2 : fs}
instructionFloatDiv state = state
-- |Mods the first float from the second float on the float stack.
instructionFloatMod :: State -> State
instructionFloatMod state@(State {_float = f1 : f2 : fs}) = state {_float = if f1 /= 0 then f2 `mod'` f1 : fs else f1 : f2 : fs}
instructionFloatMod state = state
-- |Takes the top two floats from the float stack and pushes the minimum of the two back on top.
instructionFloatMin :: State -> State
instructionFloatMin state@(State {_float = f1 : f2 : fs}) = state {_float = min f1 f2 : fs}
instructionFloatMin state = state
-- |Takes the top two floats from the float stack and pushes the maximum of the two back on top.
instructionFloatMax :: State -> State
instructionFloatMax state@(State {_float = f1 : f2 : fs}) = state {_float = max f1 f2 : fs}
instructionFloatMax state = state
-- |Adds one to the top float from the float stack.
instructionFloatInc :: State -> State
instructionFloatInc state@(State {_float = f1 : fs}) = state {_float = f1 + 1 : fs}
instructionFloatInc state = state
-- |Subtracts one from the top float from the float stack.
instructionFloatDec :: State -> State
instructionFloatDec state@(State {_float = f1 : fs}) = state {_float = f1 - 1 : fs}
instructionFloatDec state = state
-- |Takes the top two floats from the float stack and pushes the result of: the top float item < the second float item
instructionFloatLT :: State -> State
instructionFloatLT state@(State {_float = f1 : f2 : fs, _bool = bs}) = state {_float = fs, _bool = (f1 < f2) : bs}
instructionFloatLT state = state
-- |Takes the top two floats from the float stack and pushes the result of: the top float item > the second float item
instructionFloatGT :: State -> State
instructionFloatGT state@(State {_float = f1 : f2 : fs, _bool = bs}) = state {_float = fs, _bool = (f1 > f2) : bs}
instructionFloatGT state = state
-- |Takes the top two floats from the float stack and pushes the result of: the top float item <= the second float item
instructionFloatLTE :: State -> State
instructionFloatLTE state@(State {_float = f1 : f2 : fs, _bool = bs}) = state {_float = fs, _bool = (f1 <= f2) : bs}
instructionFloatLTE state = state
-- |Takes the top two floats from the float stack and pushes the result of: the top float item >= the second float item
instructionFloatGTE :: State -> State
instructionFloatGTE state@(State {_float = f1 : f2 : fs, _bool = bs}) = state {_float = fs, _bool = (f1 >= f2) : bs}
instructionFloatGTE state = state
-- |Pops the top float from the float stack.
instructionFloatPop :: State -> State
instructionFloatPop = instructionPop float
-- |Duplicates the top float on the float stack.
instructionFloatDup :: State -> State
instructionFloatDup = instructionDup float
-- |Duplicates the top float on the float stack N times based off the top of the int stack.
instructionFloatDupN :: State -> State
instructionFloatDupN = instructionDupN float
-- |Swaps the top two floats on the float stack.
instructionFloatSwap :: State -> State
instructionFloatSwap = instructionSwap float
-- |Rotates the top three floats on the float stack.
instructionFloatRot :: State -> State
instructionFloatRot = instructionRot float
-- |Sets the float stack to []
instructionFloatFlush :: State -> State
instructionFloatFlush = instructionFlush float
-- |Checks if the top two floats are equal. Pushes the result to the float stack.
instructionFloatEq :: State -> State
instructionFloatEq = instructionEq float
-- |Pushes the depth of the stack to the int stack.
instructionFloatStackDepth :: State -> State
instructionFloatStackDepth = instructionStackDepth float
-- |Moves an item from deep within the float stack to the top of the float stack based on
-- the top int from the int stack.
instructionFloatYankDup :: State -> State
instructionFloatYankDup = instructionYankDup float
-- |Copies an item from deep within the char stack to the top of the char stack based on
-- the top int from the int stack.
instructionFloatYank :: State -> State
instructionFloatYank = instructionYank float
-- |Copies an item from the top of the float stack to deep within the float stack based on
-- the top int from the int stack.
instructionFloatShoveDup :: State -> State
instructionFloatShoveDup = instructionShoveDup float
-- |Moves an item from the top of the float stack to deep within the float stack based on
-- the top int from the int stack.
instructionFloatShove :: State -> State
instructionFloatShove = instructionShove float
-- |Pushes True to the bool stack if the float stack is empty. False if not.
instructionFloatIsStackEmpty :: State -> State
instructionFloatIsStackEmpty = instructionIsStackEmpty float
-- |Pushes the sin of the top float to the float stack.
instructionFloatSin :: State -> State
instructionFloatSin state@(State {_float = f1 : fs}) = state {_float = sin f1 : fs}
instructionFloatSin state = state
-- |Pushes the cos of the top float to the float stack.
instructionFloatCos :: State -> State
instructionFloatCos state@(State {_float = f1 : fs}) = state {_float = cos f1 : fs}
instructionFloatCos state = state
-- |Pushes the tan of the top float to the float stack.
instructionFloatTan :: State -> State
instructionFloatTan state@(State {_float = f1 : fs}) = state {_float = tan f1 : fs}
instructionFloatTan state = state
-- |Duplicate the top N items from the float stack based on the top int from the int stack.
instructionFloatDupItems :: State -> State
instructionFloatDupItems = instructionDupItems float

View File

@ -8,22 +8,29 @@ import Data.List.Split
-- import Debug.Trace
-- |Utility Function: Deletes an item from a list at a specified index.
deleteAt :: Int -> [a] -> [a]
deleteAt idx xs = take idx xs <> drop 1 (drop idx xs)
-- I could probably just combine these functions
-- |Utility Function: Combines two tuples containing lists with a value placed between them.
combineTuple :: a -> ([a], [a]) -> [a]
combineTuple val tup = fst tup <> [val] <> snd tup
combineTuple val = combineTupleList [val]
-- |Utility Function: Combines two tuples containing lists with a list placed between them.
combineTupleList :: [a] -> ([a], [a]) -> [a]
combineTupleList val tup = fst tup <> val <> snd tup
-- |Utility Function: Inserts a value based on an int at a specified index.
insertAt :: Int -> a -> [a] -> [a]
insertAt idx val xs = combineTuple val (splitAt idx xs)
-- |Utility Function: Replaces a value based on an int at a specified index.
replaceAt :: Int -> a -> [a] -> [a]
replaceAt idx val xs = deleteAt (idx + 1) (insertAt idx val xs)
-- |Utility Function: Takes two ints as indicies. Sorts them low to high, sets the start to
-- 0 if the lowest start is less than 0 and the end to the length of the list - 1 if the end
-- if larger than the list. Grabs the sub list of adjusted indicies.
subList :: Int -> Int -> [a] -> [a]
subList idx0 idx1 xs =
let
@ -33,7 +40,10 @@ subList idx0 idx1 xs =
in
take adjEnd (drop adjStart xs)
-- Maybe could've used Data.List.isSubsequenceOf :shrug:
-- |Utility Function: Finds the index of the second list inside of the first index.
-- If the sublist passed is larger than the full list, returns -1
-- If the lists are of equal length, and then contents are equal, returns 0. If not equal, returns -1
-- Recursively shortens the full list until the sub list is found.
findSubA :: forall a. Eq a => [a] -> [a] -> Int
findSubA fullA subA
| length fullA < length subA = -1
@ -47,10 +57,10 @@ findSubA fullA subA
| sA == take (length sA) fA = subIndex
| otherwise = findSubA' (drop 1 fA) sA (subIndex + 1)
-- The int is the amount of olds to replace with new
-- Just chain findSubA calls lol
-- Nothing means replace all
-- May not be the most efficient method with the findSubA calls
-- |Utility Function: Replaces a number of instances of old with new in a list.
-- The Maybe Int is the amount of olds to replace with new. Nothing means replace all.
-- Just chain findSubA calls.
-- May not be the most efficient method with the findSubA calls.
replace :: Eq a => [a] -> [a] -> [a] -> Maybe Int -> [a]
replace fullA old new (Just amt) =
if findSubA fullA old /= -1 && amt > 0
@ -61,7 +71,8 @@ replace fullA old new Nothing =
then replace (take (findSubA fullA old) fullA <> new <> drop (findSubA fullA old + length old) fullA) old new Nothing
else fullA
-- a rather inefficient search
-- |Utility Function: Counts the amount of occurrences of a sub list inside
-- of a larger list.
amtOccurences :: forall a. Eq a => [a] -> [a] -> Int
amtOccurences fullA subA = amtOccurences' fullA subA 0
where
@ -71,36 +82,47 @@ amtOccurences fullA subA = amtOccurences' fullA subA 0
then amtOccurences' (replace fA sA mempty (Just 1)) sA (count + 1)
else count
-- |Utility Function: Takes the last N elements of a list.
takeR :: Int -> [a] -> [a]
takeR amt fullA = drop (length fullA - amt) fullA
-- |Utility Function: Drops the last N elements of a list.
dropR :: Int -> [a] -> [a]
dropR amt fullA = take (length fullA - amt) fullA
-- |Utility Function: A safe version of init. If the list is empty, returns the empty list.
-- If the list has items, takes the init of the list.
safeInit :: [a] -> [a]
safeInit [] = []
safeInit xs = init xs
-- |Utility Function: An indexing strategy used in parts of Hush. Takes the absolute value
-- of the passed number `mod` the length of the passed list.
absNum :: Integral a => a -> [b] -> Int
absNum rawNum lst = abs (fromIntegral rawNum) `mod` length lst
-- |Utility Function: Checks to see if a list is empty.
-- If the list is empty, returns False.
-- If the list is not empty, returns True.
notEmptyStack :: Lens' State [a] -> State -> Bool
notEmptyStack accessor state = not . null $ view accessor state
-- |Duplicates the top of a stack based on a lens.
instructionDup :: Lens' State [a] -> State -> State
instructionDup accessor state =
case uncons (view accessor state) of
Nothing -> state
Just (x1,_) -> state & accessor .~ x1 : view accessor state
-- |Pops the top of the stack based on a lens.
instructionPop :: Lens' State [a] -> State -> State
instructionPop accessor state = state & accessor .~ drop 1 (view accessor state)
-- |Pushes True if the lens' stack is empty, False if not.
instructionIsStackEmpty :: Lens' State [a] -> State -> State
instructionIsStackEmpty accessor state@(State {_bool = bs}) = state{_bool = null (view accessor state) : bs}
-- 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.
-- |Duplicates the top of a stack based on a lens and the top of the int stack.
instructionDupN :: forall a. Lens' State [a] -> State -> State
instructionDupN accessor state =
case uncons (view int state) of
@ -126,6 +148,7 @@ instructionDupItems accessor state@(State {_int = i1 : is}) =
else state{_int = is} & accessor .~ (take i1 (view accessor state{_int = is}) <> view accessor state{_int = is})
instructionDupItems _ state = state
-- |Swaps the top two instructions based on a lens
instructionSwap :: Lens' State [a] -> State -> State
instructionSwap accessor state =
state & accessor .~ swapper (view accessor state)
@ -134,9 +157,9 @@ instructionSwap accessor state =
swapper (x1 : x2 : xs) = x2 : x1 : xs
swapper xs = xs
-- Rotates top 3 integers
-- |Rotates top 3 integers based on a lens.
-- We could use template haskell to rotate any number of these as
-- an instruction later. Template haskell seems very complicated tho.
-- an instruction later.
instructionRot :: Lens' State [a] -> State -> State
instructionRot accessor state =
state & accessor .~ rotator (view accessor state)
@ -145,9 +168,12 @@ instructionRot accessor state =
rotator (x1 : x2 : x3 : xs) = x3 : x1 : x2 : xs
rotator xs = xs
-- |Deletes all instructions in a stack based on a lens.
instructionFlush :: Lens' State [a] -> State -> State
instructionFlush accessor state = state & accessor .~ []
-- |Checks if the two top instructions are equal based on a lens.
-- Pushes the result to the bool stack.
instructionEq :: forall a. Eq a => Lens' State [a] -> State -> State
instructionEq accessor state =
case uncons $ view accessor state of
@ -158,9 +184,12 @@ instructionEq accessor state =
droppedState :: State
droppedState = state & accessor .~ drop 2 (view accessor state)
-- |Calculates the stack depth based on a lens and pushes the result to the int stackk.
instructionStackDepth :: Lens' State [a] -> State -> State
instructionStackDepth accessor state@(State {_int = is}) = state{_int = length (view accessor state) : is}
-- |Copies an item from deep within a lens' stack to the top of the lens' stack based on
-- the top int from the int stack.
instructionYankDup :: Lens' State [a] -> State -> State
instructionYankDup accessor state@(State {_int = i1 : is}) =
if notEmptyStack accessor state
@ -168,6 +197,8 @@ instructionYankDup accessor state@(State {_int = i1 : is}) =
else state
instructionYankDup _ state = state
-- |Moves an item from deep within a lens' stack to the top of the lens' stack based on
-- the top int from the int stack.
instructionYank :: forall a. Lens' State [a] -> State -> State
instructionYank accessor state@(State {_int = i1 : is}) =
let
@ -181,6 +212,8 @@ instructionYank accessor state@(State {_int = i1 : is}) =
if notEmptyStack accessor state{_int = is} then deletedState & accessor .~ item : view accessor deletedState else state
instructionYank _ state = state
-- |Copies an item from the top of a lens' stack to deep within the lens' stack based on
-- the top int from the int stack.
-- In pysh, instructionShoveDup and instructionShove behave differently when indexing in such a way that
-- the duplicated index matters whether or not it's present in the stack at the moment of calculation.
-- I'm not going to keep this behavior. Check out interpysh examples for how pysh handles it.
@ -191,10 +224,12 @@ instructionShoveDup accessor state@(State {_int = i1 : is}) =
_ -> state
instructionShoveDup _ state = state
-- |Moves an item from the top of a lens' stack to deep within the lens' stack based on
-- the top int from the int stack.
instructionShove :: Lens' State [a] -> State -> State
instructionShove accessor state = instructionShoveDup accessor state & accessor .~ drop 1 (view accessor (instructionShoveDup accessor state ))
-- not char generic
-- |Concats two semigroupable items together based on a lens. Not char generic.
instructionConcat :: Semigroup a => Lens' State [a] -> State -> State
instructionConcat accessor state =
case uncons (view accessor state) of
@ -204,20 +239,26 @@ instructionConcat accessor state =
droppedState :: State
droppedState = state & accessor .~ drop 2 (view accessor state)
-- |Based on two lenses, one of a primitive type and the next of a vector type,
-- takes the top item of the primitive stack and prepends it to the first vector in
-- the vector stack if there is one.
instructionConj :: Lens' State [a] -> Lens' State [[a]] -> State -> State
instructionConj primAccessor vectorAccessor state =
case (uncons (view primAccessor state), uncons (view vectorAccessor state)) of
(Just (p1,ps), Just (v1,vs)) -> state & primAccessor .~ ps & vectorAccessor .~ ((p1 : v1) : vs)
_ -> state
-- |Based on two lenses, one of a primitive type and the next of a vector type,
-- takes the top item of the primitive stack and appends it to the first vector in
-- the vector stack if there is one.
instructionConjEnd :: Lens' State [a] -> Lens' State [[a]] -> State -> State
instructionConjEnd primAccessor vectorAccessor state =
case (uncons (view primAccessor state), uncons (view vectorAccessor state)) of
(Just (p1,ps), Just (v1,vs)) -> state & primAccessor .~ ps & vectorAccessor .~ ((v1 <> [p1]) : vs)
_ -> state
-- v for vector, vs for vectorstack (also applicable to strings)
-- Could abstract this unconsing even further in all functions below
-- |Takes the first N items from the first vector on the top of a vector stack and
-- pushes the result to said vector stack.
instructionTakeN :: Lens' State [[a]] -> State -> State
instructionTakeN accessor state@(State {_int = i1 : is}) =
case uncons (view accessor state) of
@ -360,20 +401,21 @@ instructionVectorIterate primAccessor vectorAccessor vectorType typeIterateFunct
_ -> state
instructionVectorIterate _ _ _ _ _ state = state
-- |Moves a type from a stack and places it onto the code stack.
instructionCodeFrom :: Lens' State [a] -> (a -> Gene) -> State -> State
instructionCodeFrom accessor geneType state@(State {_code = cs}) =
case uncons (view accessor state) of
Just (x, xs) -> state{_code = geneType x : cs} & accessor .~ xs
_ -> state
-- |A function that sorts the first vector for a vectorType
-- |Sorts the first vector for a vectorType
instructionVectorSort :: Ord a => Lens' State [[a]] -> State -> State
instructionVectorSort accessor state =
case uncons (view accessor state) of
Just (x, xs) -> state & accessor .~ (sort x : xs)
_ -> state
-- |A function that sorts the first vector in reverse order for a vectorType
-- |Sorts the first vector in reverse order for a vectorType
instructionVectorSortReverse :: Ord a => Lens' State [[a]] -> State -> State
instructionVectorSortReverse accessor state =
case uncons (view accessor state) of