make pattern matching parameters consistent
This commit is contained in:
parent
ff31a8fa35
commit
867f3ac440
2
TODO.md
2
TODO.md
@ -12,7 +12,7 @@
|
||||
- [X] Make int yank, shove, yankdup, and shovedup generic
|
||||
- [ ] Write hackage documentation for each function
|
||||
- [X] Refactor all functions to take state as the final parameter
|
||||
- [ ] Standardize the pattern matching parameter names, such as c1 : cs
|
||||
- [X] Standardize the pattern matching parameter names, such as c1 : cs
|
||||
- [ ] Write unit/quickcheck tests for all of the instructions
|
||||
|
||||
## PushGP TODO
|
||||
|
||||
@ -4,26 +4,26 @@ import HushGP.State
|
||||
import HushGP.Instructions.GenericInstructions
|
||||
|
||||
instructionBoolFromInt :: State -> State
|
||||
instructionBoolFromInt state@(State {_int = (i : is), _bool = bs}) = state {_int = is, _bool = (i /= 0) : bs}
|
||||
instructionBoolFromInt state@(State {_int = i1 : is, _bool = bs}) = state {_int = is, _bool = (i1 /= 0) : bs}
|
||||
instructionBoolFromInt state = state
|
||||
|
||||
instructionBoolFromFloat :: State -> State
|
||||
instructionBoolFromFloat state@(State {_float = (f : fs), _bool = bs}) = state {_float = fs, _bool = (f /= 0) : bs}
|
||||
instructionBoolFromFloat state@(State {_float = f1 : fs, _bool = bs}) = state {_float = fs, _bool = (f1 /= 0) : bs}
|
||||
instructionBoolFromFloat state = state
|
||||
|
||||
boolTemplate :: (Bool -> Bool -> Bool) -> State -> State
|
||||
boolTemplate func state@(State {_bool = (b1 : b2 : bs)}) = state {_bool = func b1 b2 : bs}
|
||||
boolTemplate func state@(State {_bool = b1 : b2 : bs}) = state {_bool = func b1 b2 : bs}
|
||||
boolTemplate _ state = state
|
||||
|
||||
instructionBoolAnd :: State -> State
|
||||
instructionBoolAnd = boolTemplate (&&)
|
||||
|
||||
instructionBoolInvertFirstThenAnd :: State -> State
|
||||
instructionBoolInvertFirstThenAnd state@(State {_bool = (b1 : bs)}) = boolTemplate (&&) state {_bool = not b1 : bs}
|
||||
instructionBoolInvertFirstThenAnd state@(State {_bool = b1 : bs}) = boolTemplate (&&) state {_bool = not b1 : bs}
|
||||
instructionBoolInvertFirstThenAnd state = state
|
||||
|
||||
instructionBoolInvertSecondThenAnd :: State -> State
|
||||
instructionBoolInvertSecondThenAnd state@(State {_bool = (b1 : b2 : bs)}) = boolTemplate (&&) state {_bool = b1 : not b2 : bs}
|
||||
instructionBoolInvertSecondThenAnd state@(State {_bool = b1 : b2 : bs}) = boolTemplate (&&) state {_bool = b1 : not b2 : bs}
|
||||
instructionBoolInvertSecondThenAnd state = state
|
||||
|
||||
instructionBoolOr :: State -> State
|
||||
|
||||
@ -11,11 +11,11 @@ isBlock (Block _) = True
|
||||
isBlock _ = False
|
||||
|
||||
blockLength :: Gene -> Int
|
||||
blockLength (Block xs) = length xs
|
||||
blockLength (Block bxs) = length bxs
|
||||
blockLength _ = 1
|
||||
|
||||
blockIsNull :: Gene -> Bool
|
||||
blockIsNull (Block xs) = null xs
|
||||
blockIsNull (Block bxs) = null bxs
|
||||
blockIsNull _ = False
|
||||
|
||||
-- https://faculty.hampshire.edu/lspector/push3-description.html#Type
|
||||
@ -29,7 +29,7 @@ findContainer (Block fullA) gene
|
||||
where
|
||||
findContainer' :: [Gene] -> Gene -> Gene
|
||||
findContainer' [] _ = Block []
|
||||
findContainer' ((Block x) : xs) g = if g `elem` x then Block x else findContainer' xs g
|
||||
findContainer' ((Block bx1) : bxs) g = if g `elem` bx1 then Block bx1 else findContainer' bxs g
|
||||
findContainer' _ _ = Block [] -- This should never happen
|
||||
findContainer _ _ = Block []
|
||||
|
||||
@ -38,21 +38,21 @@ countDiscrepancy (Block xs) (Block ys) = sum [if uncurry (==) tup then 0 else 1
|
||||
countDiscrepancy xgene ygene = if xgene == ygene then 1 else 0
|
||||
|
||||
extractFirstFromBlock :: Gene -> Gene
|
||||
extractFirstFromBlock (Block (x : _)) = x
|
||||
extractFirstFromBlock (Block (bx1 : _)) = bx1
|
||||
extractFirstFromBlock gene = gene
|
||||
|
||||
extractLastFromBlock :: Gene -> Gene
|
||||
extractLastFromBlock (Block []) = Block []
|
||||
extractLastFromBlock (Block xs) = last xs
|
||||
extractLastFromBlock (Block bxs) = last bxs
|
||||
extractLastFromBlock gene = gene
|
||||
|
||||
extractInitFromBlock :: Gene -> Gene
|
||||
extractInitFromBlock (Block []) = Block []
|
||||
extractInitFromBlock (Block xs) = Block (init xs)
|
||||
extractInitFromBlock (Block bxs) = Block (init bxs)
|
||||
extractInitFromBlock gene = gene
|
||||
|
||||
extractTailFromBlock :: Gene -> Gene
|
||||
extractTailFromBlock (Block xs) = Block (drop 1 xs)
|
||||
extractTailFromBlock (Block bxs) = Block (drop 1 bxs)
|
||||
extractTailFromBlock _ = Block []
|
||||
|
||||
codeAtPoint :: [Gene] -> Int -> Gene
|
||||
@ -68,48 +68,48 @@ codeInsertAtPoint ((Block genes) : oldGenes) gene index = Block (codeInsertAtPoi
|
||||
codeInsertAtPoint (oldGene : oldGenes) gene index = oldGene : codeInsertAtPoint oldGenes gene (index - 1)
|
||||
|
||||
codeCombine :: Gene -> Gene -> Gene
|
||||
codeCombine (Block xs) (Block ys) = Block (xs <> ys)
|
||||
codeCombine (Block xs) ygene = Block (ygene : xs)
|
||||
codeCombine xgene (Block ys) = Block (xgene : ys)
|
||||
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]
|
||||
|
||||
codeMember :: Gene -> Gene -> Bool
|
||||
codeMember (Block _) (Block _) = False -- Can't compare two lists with `elem`
|
||||
codeMember (Block xs) ygene = ygene `elem` xs
|
||||
codeMember (Block bxs) (Block bys) = findSubA bxs bys /= (-1)
|
||||
codeMember (Block bxs) ygene = ygene `elem` bxs
|
||||
codeMember _ _ = False
|
||||
|
||||
codeRecursiveSize :: Gene -> Int
|
||||
codeRecursiveSize (Block xs) = sum [codeRecursiveSize x + if isBlock x then 1 else 0 | x <- xs]
|
||||
codeRecursiveSize (Block bxs) = sum [codeRecursiveSize x + if isBlock x then 1 else 0 | x <- bxs]
|
||||
codeRecursiveSize _ = 1
|
||||
|
||||
instructionCodePop :: State -> State
|
||||
instructionCodePop = instructionPop code
|
||||
|
||||
instructionCodeIsCodeBlock :: State -> State
|
||||
instructionCodeIsCodeBlock state@(State {_code = (c : cs), _bool = bs}) = state {_code = cs, _bool = isBlock c : bs}
|
||||
instructionCodeIsCodeBlock state@(State {_code = c1 : cs, _bool = bs}) = state {_code = cs, _bool = isBlock c1 : bs}
|
||||
instructionCodeIsCodeBlock state = state
|
||||
|
||||
instructionCodeIsSingular :: State -> State
|
||||
instructionCodeIsSingular state@(State {_code = (c : cs), _bool = bs}) = state {_code = cs, _bool = not (isBlock c) : bs}
|
||||
instructionCodeIsSingular state@(State {_code = c1 : cs, _bool = bs}) = state {_code = cs, _bool = not (isBlock c1) : bs}
|
||||
instructionCodeIsSingular state = state
|
||||
|
||||
instructionCodeLength :: State -> State
|
||||
instructionCodeLength state@(State {_code = (c : cs), _int = is}) = state {_code = cs, _int = blockLength c : is}
|
||||
instructionCodeLength state@(State {_code = c1 : cs, _int = is}) = state {_code = cs, _int = blockLength c1 : is}
|
||||
instructionCodeLength state = state
|
||||
|
||||
-- CODE.CAR
|
||||
instructionCodeFirst :: State -> State
|
||||
instructionCodeFirst state@(State {_code = (c : cs)}) = state {_code = extractFirstFromBlock c : cs}
|
||||
instructionCodeFirst state@(State {_code = c1 : cs}) = state {_code = extractFirstFromBlock c1 : cs}
|
||||
instructionCodeFirst state = state
|
||||
|
||||
instructionCodeLast :: State -> State
|
||||
instructionCodeLast state@(State {_code = (c : cs)}) = state {_code = extractLastFromBlock c : cs}
|
||||
instructionCodeLast state@(State {_code = c1 : cs}) = state {_code = extractLastFromBlock c1 : cs}
|
||||
instructionCodeLast state = state
|
||||
|
||||
-- CODE.CDR
|
||||
-- https://erp12.github.io/pyshgp/html/core_instructions.html#code-rest
|
||||
instructionCodeTail :: State -> State
|
||||
instructionCodeTail state@(State {_code = (c : cs)}) = state {_code = extractTailFromBlock c : cs}
|
||||
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
|
||||
@ -124,19 +124,19 @@ instructionCodeTailN state = state
|
||||
|
||||
-- https://erp12.github.io/pyshgp/html/core_instructions.html#code-but-last
|
||||
instructionCodeInit :: State -> State
|
||||
instructionCodeInit state@(State {_code = (c : cs)}) = state {_code = extractInitFromBlock c : cs}
|
||||
instructionCodeInit state@(State {_code = c1 : cs}) = state {_code = extractInitFromBlock c1 : cs}
|
||||
instructionCodeInit state = state
|
||||
|
||||
instructionCodeWrap :: State -> State
|
||||
instructionCodeWrap state@(State {_code = (c : cs)}) = state {_code = Block [c] : cs}
|
||||
instructionCodeWrap state@(State {_code = c1 : cs}) = state {_code = Block [c1] : cs}
|
||||
instructionCodeWrap state = state
|
||||
|
||||
instructionCodeList :: State -> State
|
||||
instructionCodeList state@(State {_code = (c1 : c2 : cs)}) = state {_code = Block [c1, c2] : cs}
|
||||
instructionCodeList state@(State {_code = c1 : c2 : cs}) = state {_code = Block [c1, c2] : cs}
|
||||
instructionCodeList state = state
|
||||
|
||||
instructionCodeCombine :: State -> State
|
||||
instructionCodeCombine state@(State {_code = (c1 : c2 : cs)}) = state {_code = codeCombine c1 c2 : cs}
|
||||
instructionCodeCombine state@(State {_code = c1 : c2 : cs}) = state {_code = codeCombine c1 c2 : cs}
|
||||
instructionCodeCombine state = state
|
||||
|
||||
instructionCodeDo :: State -> State
|
||||
@ -144,7 +144,7 @@ instructionCodeDo state@(State {_code = c1 : cs, _exec = es}) = state {_code = c
|
||||
instructionCodeDo state = state
|
||||
|
||||
instructionCodeDoDup :: State -> State
|
||||
instructionCodeDoDup state@(State {_code = (c1 : cs), _exec = es}) = state {_code = c1 : cs, _exec = c1 : es}
|
||||
instructionCodeDoDup state@(State {_code = c1 : cs, _exec = es}) = state {_code = c1 : cs, _exec = c1 : es}
|
||||
instructionCodeDoDup state = state
|
||||
|
||||
-- https://erp12.github.io/pyshgp/html/core_instructions.html#code-do-then-pop
|
||||
@ -159,7 +159,7 @@ codeDoRange :: Gene
|
||||
codeDoRange = StateFunc (instructionCodeDoRange, "instructionCodeDoRange")
|
||||
|
||||
instructionCodeDoRange :: State -> State
|
||||
instructionCodeDoRange state@(State {_code = (c1 : cs), _int = (i0 : i1 : is), _exec = es}) =
|
||||
instructionCodeDoRange state@(State {_code = c1 : cs, _int = i0 : i1 : is, _exec = es}) =
|
||||
if increment i0 i1 /= 0
|
||||
then state {_exec = c1 : Block [GeneInt (i1 + increment i0 i1), GeneInt i0, codeFromExec, c1, codeDoRange] : es, _int = i1 : is, _code = cs}
|
||||
else state {_exec = c1: es, _int = i1 : is, _code = cs}
|
||||
@ -172,42 +172,42 @@ instructionCodeDoRange state@(State {_code = (c1 : cs), _int = (i0 : i1 : is), _
|
||||
instructionCodeDoRange state = state
|
||||
|
||||
instructionCodeDoCount :: State -> State
|
||||
instructionCodeDoCount state@(State {_code = (c : cs), _int = (i : is), _exec = es}) =
|
||||
if i < 1
|
||||
instructionCodeDoCount state@(State {_code = c : cs, _int = i1 : is, _exec = es}) =
|
||||
if i1 < 1
|
||||
then state
|
||||
else state {_code = cs, _int = is, _exec = Block [GeneInt 0, GeneInt $ i - 1, codeFromExec, c, codeDoRange] : es}
|
||||
else state {_code = cs, _int = is, _exec = Block [GeneInt 0, GeneInt $ i1 - 1, codeFromExec, c, codeDoRange] : es}
|
||||
instructionCodeDoCount state = state
|
||||
|
||||
instructionCodeDoTimes :: State -> State
|
||||
instructionCodeDoTimes state@(State {_code = (c : cs), _int = (i : is), _exec = es}) =
|
||||
if i < 1
|
||||
instructionCodeDoTimes state@(State {_code = c : cs, _int = i1 : is, _exec = es}) =
|
||||
if i1 < 1
|
||||
then state
|
||||
else state {_code = cs, _int = is, _exec = Block [GeneInt 0, GeneInt $ i - 1, codeFromExec, Block [StateFunc (instructionIntPop, "instructionIntPop"), c], codeDoRange] : 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
|
||||
|
||||
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 {_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
|
||||
|
||||
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 {_code = c1 : cs, _bool = b1 : bs, _exec = es}) = state{_code = cs, _bool = bs, _exec = if b1 then c1 : es else es}
|
||||
instructionCodeWhen state = state
|
||||
|
||||
instructionCodeMember :: State -> State
|
||||
instructionCodeMember state@(State {_code = (c1 : c2 : cs), _bool = bs}) = state{_code = cs, _bool = codeMember c1 c2 : bs}
|
||||
instructionCodeMember state@(State {_code = c1 : c2 : cs, _bool = bs}) = state{_code = cs, _bool = codeMember c1 c2 : bs}
|
||||
instructionCodeMember state = state
|
||||
|
||||
-- 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
|
||||
instructionCodeN state@(State {_code = ((Block c1) : cs), _int = (i1 : is)}) =
|
||||
instructionCodeN state@(State {_code = (Block c1) : cs, _int = i1 : is}) =
|
||||
if not $ null c1
|
||||
then state {_code = c1 !! index : cs, _int = is}
|
||||
else state
|
||||
where
|
||||
index :: Int
|
||||
index = abs i1 `mod` length c1
|
||||
instructionCodeN state@(State {_code = (c1 : cs), _int = _ : is}) = state {_code = c1 : cs, _int = is}
|
||||
instructionCodeN state@(State {_code = c1 : cs, _int = _ : is}) = state {_code = c1 : cs, _int = is}
|
||||
instructionCodeN state = state
|
||||
|
||||
instructionMakeEmptyCodeBlock :: State -> State
|
||||
@ -226,7 +226,7 @@ instructionCodeSize state = state
|
||||
-- I designed this function differently so 0 returns the 0th element, and the last item
|
||||
-- in the codeblock can be returned.
|
||||
instructionCodeExtract :: State -> State
|
||||
instructionCodeExtract state@(State {_code = (block@(Block c1) : cs), _int = i1 : is}) =
|
||||
instructionCodeExtract state@(State {_code = block@(Block c1) : cs, _int = i1 : is}) =
|
||||
let
|
||||
index = abs i1 `mod` codeRecursiveSize block
|
||||
in
|
||||
@ -235,7 +235,7 @@ instructionCodeExtract state@(State {_code = cs, _int = _ : is}) = state{_code =
|
||||
instructionCodeExtract state = state
|
||||
|
||||
instructionCodeInsert :: State -> State
|
||||
instructionCodeInsert state@(State {_code = (block@(Block c1) : c2 : cs), _int = i1 : is}) =
|
||||
instructionCodeInsert state@(State {_code = block@(Block c1) : c2 : cs, _int = i1 : is}) =
|
||||
let
|
||||
index = abs i1 `mod` codeRecursiveSize block
|
||||
in
|
||||
|
||||
@ -5,8 +5,8 @@ import HushGP.Instructions.IntInstructions
|
||||
import HushGP.Instructions.GenericInstructions
|
||||
|
||||
instructionExecIf :: State -> State
|
||||
instructionExecIf state@(State {_exec = (e1 : e2 : es), _bool = (b : bs)}) =
|
||||
if b
|
||||
instructionExecIf state@(State {_exec = e1 : e2 : es, _bool = b1 : bs}) =
|
||||
if b1
|
||||
then state {_exec = e1 : es, _bool = bs}
|
||||
else state {_exec = e2 : es, _bool = bs}
|
||||
instructionExecIf state = state
|
||||
@ -54,7 +54,7 @@ execDoRange :: Gene
|
||||
execDoRange = StateFunc (instructionExecDoRange, "instructionExecDoRange")
|
||||
|
||||
instructionExecDoRange :: State -> State
|
||||
instructionExecDoRange state@(State {_exec = (e1 : es), _int = (i0 : i1 : is)}) =
|
||||
instructionExecDoRange state@(State {_exec = e1 : es, _int = i0 : i1 : is}) =
|
||||
if increment i0 i1 /= 0
|
||||
then state {_exec = e1 : Block [GeneInt (i1 + increment i0 i1), GeneInt i0, execDoRange, e1] : es, _int = i1 : is}
|
||||
else state {_exec = e1 : es, _int = i1 : is}
|
||||
@ -67,40 +67,40 @@ instructionExecDoRange state@(State {_exec = (e1 : es), _int = (i0 : i1 : is)})
|
||||
instructionExecDoRange state = state
|
||||
|
||||
instructionExecDoCount :: State -> State
|
||||
instructionExecDoCount state@(State {_exec = (e : es), _int = (i : is)}) =
|
||||
if i < 1
|
||||
instructionExecDoCount state@(State {_exec = e1 : es, _int = i1 : is}) =
|
||||
if i1 < 1
|
||||
then state
|
||||
else state {_exec = Block [GeneInt 0, GeneInt $ i - 1, execDoRange, e] : es, _int = is}
|
||||
else state {_exec = Block [GeneInt 0, GeneInt $ i1 - 1, execDoRange, e1] : es, _int = is}
|
||||
instructionExecDoCount state = state
|
||||
|
||||
instructionExecDoTimes :: State -> State
|
||||
instructionExecDoTimes state@(State {_exec = (e : es), _int = (i : is)}) =
|
||||
if i < 1
|
||||
instructionExecDoTimes state@(State {_exec = e1 : es, _int = i1 : is}) =
|
||||
if i1 < 1
|
||||
then state
|
||||
else state {_exec = Block [GeneInt 0, GeneInt $ i - 1, execDoRange, Block [StateFunc (instructionIntPop, "instructionIntPop"), e]] : es, _int = is}
|
||||
else state {_exec = Block [GeneInt 0, GeneInt $ i1 - 1, execDoRange, Block [StateFunc (instructionIntPop, "instructionIntPop"), e1]] : es, _int = is}
|
||||
instructionExecDoTimes state = state
|
||||
|
||||
execWhile :: Gene
|
||||
execWhile = StateFunc (instructionExecWhile, "instructionExecWhile")
|
||||
|
||||
instructionExecWhile :: State -> State
|
||||
instructionExecWhile state@(State {_exec = (_ : es), _bool = []}) =
|
||||
instructionExecWhile state@(State {_exec = _ : es, _bool = []}) =
|
||||
state {_exec = es}
|
||||
instructionExecWhile state@(State {_exec = alles@(e : es), _bool = (b : bs)}) =
|
||||
if b
|
||||
then state {_exec = e : execWhile : alles, _bool = bs}
|
||||
instructionExecWhile state@(State {_exec = alles@(e1 : es), _bool = b1 : bs}) =
|
||||
if b1
|
||||
then state {_exec = e1 : execWhile : alles, _bool = bs}
|
||||
else state {_exec = es}
|
||||
instructionExecWhile state = state
|
||||
|
||||
instructionExecDoWhile :: State -> State
|
||||
instructionExecDoWhile state@(State {_exec = alles@(e : _)}) =
|
||||
state {_exec = e : execWhile : alles}
|
||||
instructionExecDoWhile state@(State {_exec = alles@(e1 : _)}) =
|
||||
state {_exec = e1 : execWhile : alles}
|
||||
instructionExecDoWhile state = state
|
||||
|
||||
-- Eats the _boolean no matter what
|
||||
instructionExecWhen :: State -> State
|
||||
instructionExecWhen state@(State {_exec = (_ : es), _bool = (b : bs)}) =
|
||||
if not b
|
||||
instructionExecWhen state@(State {_exec = _ : es, _bool = b1 : bs}) =
|
||||
if not b1
|
||||
then state {_exec = es, _bool = bs}
|
||||
else state {_bool = bs}
|
||||
instructionExecWhen state = state
|
||||
|
||||
@ -6,15 +6,15 @@ import HushGP.State
|
||||
import Data.Char
|
||||
|
||||
instructionFloatFromInt :: State -> State
|
||||
instructionFloatFromInt state@(State {_float = fs, _int = (i : is)}) = state {_float = (fromIntegral i :: Float) : fs, _int = is}
|
||||
instructionFloatFromInt state@(State {_float = fs, _int = i1 : is}) = state {_float = (fromIntegral i1 :: Float) : fs, _int = is}
|
||||
instructionFloatFromInt state = state
|
||||
|
||||
instructionFloatFromBool :: State -> State
|
||||
instructionFloatFromBool state@(State {_bool = (b : bs), _float = fs}) = state {_bool = bs, _float = (if b then 1.0 else 0.0) : fs}
|
||||
instructionFloatFromBool state@(State {_bool = b1 : bs, _float = fs}) = state {_bool = bs, _float = (if b1 then 1.0 else 0.0) : fs}
|
||||
instructionFloatFromBool state = state
|
||||
|
||||
instructionFloatFromChar :: State -> State
|
||||
instructionFloatFromChar state@(State {_char = c : cs, _float = fs}) = state {_char = cs, _float = (fromIntegral (ord c) :: Float) : fs}
|
||||
instructionFloatFromChar state@(State {_char = c1 : cs, _float = fs}) = state {_char = cs, _float = (fromIntegral (ord c1) :: Float) : fs}
|
||||
instructionFloatFromChar state = state
|
||||
|
||||
instructionFloatFromString :: State -> State
|
||||
@ -25,39 +25,39 @@ instructionFloatFromString state@(State {_string = s1 : ss, _float = fs}) =
|
||||
instructionFloatFromString state = state
|
||||
|
||||
instructionFloatAdd :: State -> State
|
||||
instructionFloatAdd state@(State {_float = (f1 : f2 : fs)}) = state {_float = f2 + f1 : fs}
|
||||
instructionFloatAdd state@(State {_float = f1 : f2 : fs}) = state {_float = f2 + f1 : fs}
|
||||
instructionFloatAdd state = state
|
||||
|
||||
instructionFloatSub :: State -> State
|
||||
instructionFloatSub state@(State {_float = (f1 : f2 : fs)}) = state {_float = f2 - f1 : fs}
|
||||
instructionFloatSub state@(State {_float = f1 : f2 : fs}) = state {_float = f2 - f1 : fs}
|
||||
instructionFloatSub state = state
|
||||
|
||||
instructionFloatMul :: State -> State
|
||||
instructionFloatMul state@(State {_float = (f1 : f2 : fs)}) = state {_float = f2 * f1 : fs}
|
||||
instructionFloatMul state@(State {_float = f1 : f2 : fs}) = state {_float = f2 * f1 : fs}
|
||||
instructionFloatMul state = state
|
||||
|
||||
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 {_float = f1 : f2 : fs}) = state {_float = if f1 /= 0 then f2 / f1 : fs else f1 : f2 : fs}
|
||||
instructionFloatDiv state = state
|
||||
|
||||
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 {_float = f1 : f2 : fs}) = state {_float = if f1 /= 0 then f2 `mod'` f1 : fs else f1 : f2 : fs}
|
||||
instructionFloatMod state = state
|
||||
|
||||
instructionFloatMin :: State -> State
|
||||
instructionFloatMin state@(State {_float = (f1 : f2 : fs)}) = state {_float = min f1 f2 : fs}
|
||||
instructionFloatMin state@(State {_float = f1 : f2 : fs}) = state {_float = min f1 f2 : fs}
|
||||
instructionFloatMin state = state
|
||||
|
||||
instructionFloatMax :: State -> State
|
||||
instructionFloatMax state@(State {_float = (f1 : f2 : fs)}) = state {_float = max f1 f2 : fs}
|
||||
instructionFloatMax state@(State {_float = f1 : f2 : fs}) = state {_float = max f1 f2 : fs}
|
||||
instructionFloatMax state = state
|
||||
|
||||
instructionFloatInc :: State -> State
|
||||
instructionFloatInc state@(State {_float = (f1 : fs)}) = state {_float = f1 + 1 : fs}
|
||||
instructionFloatInc state@(State {_float = f1 : fs}) = state {_float = f1 + 1 : fs}
|
||||
instructionFloatInc state = state
|
||||
|
||||
instructionFloatDec :: State -> State
|
||||
instructionFloatDec state@(State {_float = (f1 : fs)}) = state {_float = f1 - 1 : fs}
|
||||
instructionFloatDec state@(State {_float = f1 : fs}) = state {_float = f1 - 1 : fs}
|
||||
instructionFloatDec state = state
|
||||
|
||||
instructionFloatLT :: State -> State
|
||||
|
||||
@ -91,7 +91,7 @@ instructionDup :: Lens' State [a] -> State -> State
|
||||
instructionDup accessor state =
|
||||
case uncons (view accessor state) of
|
||||
Nothing -> state
|
||||
Just (x,_) -> state & accessor .~ x : view accessor state
|
||||
Just (x1,_) -> state & accessor .~ x1 : view accessor state
|
||||
|
||||
instructionPop :: Lens' State [a] -> State -> State
|
||||
instructionPop accessor state = state & accessor .~ drop 1 (view accessor state)
|
||||
@ -117,7 +117,7 @@ instructionDupN accessor state =
|
||||
then instructionDupNHelper (count - 1) instruction internalAccessor (internalState & accessor .~ (instruction : view accessor internalState))
|
||||
else internalState
|
||||
|
||||
-- |Duplicates the top N items on a stack. If n <= 0 nothing happens
|
||||
-- |Duplicates the top N items on a stack. If n <= 0, nothing happens
|
||||
-- TODO: Will need to implement a max stack items at some point
|
||||
instructionDupItems :: Lens' State [a] -> State -> State
|
||||
instructionDupItems accessor state@(State {_int = i1 : is}) =
|
||||
@ -162,17 +162,17 @@ instructionStackDepth :: Lens' State [a] -> State -> State
|
||||
instructionStackDepth accessor state@(State {_int = is}) = state{_int = length (view accessor state) : is}
|
||||
|
||||
instructionYankDup :: Lens' State [a] -> State -> State
|
||||
instructionYankDup accessor state@(State {_int = i : is}) =
|
||||
instructionYankDup accessor state@(State {_int = i1 : is}) =
|
||||
if notEmptyStack accessor state
|
||||
then state{_int = is} & accessor .~ (view accessor state{_int = is} !! max 0 (min i (length (view accessor state{_int = is}) - 1))) : view accessor state{_int = is}
|
||||
then state{_int = is} & accessor .~ (view accessor state{_int = is} !! max 0 (min i1 (length (view accessor state{_int = is}) - 1))) : view accessor state{_int = is}
|
||||
else state
|
||||
instructionYankDup _ state = state
|
||||
|
||||
instructionYank :: forall a. Lens' State [a] -> State -> State
|
||||
instructionYank accessor state@(State {_int = i : is}) =
|
||||
instructionYank accessor state@(State {_int = i1 : is}) =
|
||||
let
|
||||
myIndex :: Int
|
||||
myIndex = max 0 (min i (length (view accessor state{_int = is}) - 1))
|
||||
myIndex = max 0 (min i1 (length (view accessor state{_int = is}) - 1))
|
||||
item :: a
|
||||
item = view accessor state{_int = is} !! myIndex
|
||||
deletedState :: State
|
||||
@ -185,9 +185,9 @@ instructionYank _ state = state
|
||||
-- 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.
|
||||
instructionShoveDup :: Lens' State [a] -> State -> State
|
||||
instructionShoveDup accessor state@(State {_int = i : is}) =
|
||||
instructionShoveDup accessor state@(State {_int = i1 : is}) =
|
||||
case uncons (view accessor state{_int = is}) of
|
||||
Just (x,_) -> state{_int = is} & accessor .~ combineTuple x (splitAt (max 0 (min i (length (view accessor state{_int = is}) - 1))) (view accessor state{_int = is}))
|
||||
Just (x,_) -> state{_int = is} & accessor .~ combineTuple x (splitAt (max 0 (min i1 (length (view accessor state{_int = is}) - 1))) (view accessor state{_int = is}))
|
||||
_ -> state
|
||||
instructionShoveDup _ state = state
|
||||
|
||||
|
||||
@ -6,15 +6,15 @@ import Data.Char
|
||||
-- import Debug.Trace
|
||||
|
||||
instructionIntFromFloat :: State -> State
|
||||
instructionIntFromFloat state@(State {_float = (f : fs), _int = is}) = state {_float = fs, _int = floor f : is}
|
||||
instructionIntFromFloat state@(State {_float = f1 : fs, _int = is}) = state {_float = fs, _int = floor f1 : is}
|
||||
instructionIntFromFloat state = state
|
||||
|
||||
instructionIntFromBool :: State -> State
|
||||
instructionIntFromBool state@(State {_bool = (b : bs), _int = is}) = state {_bool = bs, _int = (if b then 1 else 0) : is}
|
||||
instructionIntFromBool state@(State {_bool = b1 : bs, _int = is}) = state {_bool = bs, _int = (if b1 then 1 else 0) : is}
|
||||
instructionIntFromBool state = state
|
||||
|
||||
instructionIntFromChar :: State -> State
|
||||
instructionIntFromChar state@(State {_char = c : cs, _int = is}) = state {_char = cs, _int = ord c : is}
|
||||
instructionIntFromChar state@(State {_char = c1 : cs, _int = is}) = state {_char = cs, _int = ord c1 : is}
|
||||
instructionIntFromChar state = state
|
||||
|
||||
instructionIntFromString :: State -> State
|
||||
@ -25,39 +25,39 @@ instructionIntFromString state@(State {_string = s1 : ss, _int = is}) =
|
||||
instructionIntFromString state = state
|
||||
|
||||
instructionIntAdd :: State -> State
|
||||
instructionIntAdd state@(State {_int = (i1 : i2 : is)}) = state {_int = i2 + i1 : is}
|
||||
instructionIntAdd state@(State {_int = i1 : i2 : is}) = state {_int = i2 + i1 : is}
|
||||
instructionIntAdd state = state
|
||||
|
||||
instructionIntSub :: State -> State
|
||||
instructionIntSub state@(State {_int = (i1 : i2 : is)}) = state {_int = i2 - i1 : is}
|
||||
instructionIntSub state@(State {_int = i1 : i2 : is}) = state {_int = i2 - i1 : is}
|
||||
instructionIntSub state = state
|
||||
|
||||
instructionIntMul :: State -> State
|
||||
instructionIntMul state@(State {_int = (i1 : i2 : is)}) = state {_int = i2 * i1 : is}
|
||||
instructionIntMul state@(State {_int = i1 : i2 : is}) = state {_int = i2 * i1 : is}
|
||||
instructionIntMul state = state
|
||||
|
||||
instructionIntDiv :: State -> State
|
||||
instructionIntDiv state@(State {_int = (i1 : i2 : is)}) = state {_int = if i1 /= 0 then (i2 `div` i1) : is else i1 : i2 : is}
|
||||
instructionIntDiv state@(State {_int = i1 : i2 : is}) = state {_int = if i1 /= 0 then (i2 `div` i1) : is else i1 : i2 : is}
|
||||
instructionIntDiv state = state
|
||||
|
||||
instructionIntMod :: State -> State
|
||||
instructionIntMod state@(State {_int = (i1 : i2 : is)}) = state {_int = if i1 /= 0 then (i2 `mod` i1) : is else i1 : i2 : is}
|
||||
instructionIntMod state@(State {_int = i1 : i2 : is}) = state {_int = if i1 /= 0 then (i2 `mod` i1) : is else i1 : i2 : is}
|
||||
instructionIntMod state = state
|
||||
|
||||
instructionIntMin :: State -> State
|
||||
instructionIntMin state@(State {_int = (i1 : i2 : is)}) = state {_int = min i1 i2 : is}
|
||||
instructionIntMin state@(State {_int = i1 : i2 : is}) = state {_int = min i1 i2 : is}
|
||||
instructionIntMin state = state
|
||||
|
||||
instructionIntMax :: State -> State
|
||||
instructionIntMax state@(State {_int = (i1 : i2 : is)}) = state {_int = max i1 i2 : is}
|
||||
instructionIntMax state@(State {_int = i1 : i2 : is}) = state {_int = max i1 i2 : is}
|
||||
instructionIntMax state = state
|
||||
|
||||
instructionIntInc :: State -> State
|
||||
instructionIntInc state@(State {_int = (i1 : is)}) = state {_int = i1 + 1 : is}
|
||||
instructionIntInc state@(State {_int = i1 : is}) = state {_int = i1 + 1 : is}
|
||||
instructionIntInc state = state
|
||||
|
||||
instructionIntDec :: State -> State
|
||||
instructionIntDec state@(State {_int = (i1 : is)}) = state {_int = i1 - 1 : is}
|
||||
instructionIntDec state@(State {_int = i1 : is}) = state {_int = i1 - 1 : is}
|
||||
instructionIntDec state = state
|
||||
|
||||
instructionIntLT :: State -> State
|
||||
|
||||
@ -182,7 +182,7 @@ 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}
|
||||
Just (x1,_) -> state{_string = show x1 : ss}
|
||||
|
||||
instructionStringFromBool :: State -> State
|
||||
instructionStringFromBool state = instructionStringFromLens state bool
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user