diff --git a/TODO.md b/TODO.md new file mode 100644 index 0000000..de4ec89 --- /dev/null +++ b/TODO.md @@ -0,0 +1,12 @@ +# TODO + +## Push Language TODO + +- [ ] Make all vector functions applicable to string functions and vice versa +- [ ] Implement all functions as seen in propeller +- [ ] Implement Linear Algebra functions as specified in the previous papers +- [ ] Add a function to sort a vector +- [x] Make int yank, shove, yankdup, and shovedup generic + +## PushGP TODO +- [ ] Implement a Plushy genome translator diff --git a/src/Instructions/GenericInstructions.hs b/src/Instructions/GenericInstructions.hs index e20a68d..872fff1 100644 --- a/src/Instructions/GenericInstructions.hs +++ b/src/Instructions/GenericInstructions.hs @@ -57,6 +57,7 @@ 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 amtOccurences :: forall a. Eq a => [a] -> [a] -> Int amtOccurences fullA subA = amtOccurences' fullA subA 0 where @@ -149,39 +150,36 @@ instructionEq state accessor = instructionStackDepth :: State -> Lens' State [a] -> 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 instructionYankDup state@(State {_int = i : is}) accessor = if notEmptyStack state accessor - then (state & accessor .~ (view accessor state !! max 0 (min i (length (view accessor state) - 1))) : view accessor state) {_int = is} + 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} else state instructionYankDup state _ = state --- Is this optimal? Running instrucitonYankDup twice????? --- int non generic too instructionYank :: forall a. State -> Lens' State [a] -> State -instructionYank state@(State {_int = rawIndex : _}) accessor = +instructionYank state@(State {_int = i : is}) accessor = let myIndex :: Int - myIndex = max 0 (min rawIndex (length (view accessor state) - 1)) + myIndex = max 0 (min i (length (view accessor state{_int = is}) - 1)) item :: a - item = view accessor state !! myIndex + item = view accessor state{_int = is} !! myIndex deletedState :: State - deletedState = state & accessor .~ deleteAt myIndex (view accessor state) + deletedState = state{_int = is} & accessor .~ deleteAt myIndex (view accessor state{_int = is}) in - if notEmptyStack state accessor then deletedState & accessor .~ item : view accessor deletedState else state + if notEmptyStack state{_int = is} accessor then deletedState & accessor .~ item : view accessor deletedState else state instructionYank state _ = state --- int non generic :( --- Rewrite this eventually? +-- 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. instructionShoveDup :: State -> Lens' State [a] -> State instructionShoveDup state@(State {_int = i : is}) accessor = - case uncons (view accessor state) of - Just (x,_) -> (state & accessor .~ combineTuple x (splitAt (max 0 (min i (length (view accessor state) - 1))) (view accessor state))) {_int = 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})) _ -> state -instructionShoveDup state@(State {_int = []}) _ = state +instructionShoveDup state _ = state --- also also not int generic instructionShove :: State -> Lens' State [a] -> State instructionShove state accessor = instructionShoveDup state accessor & accessor .~ drop 1 (view accessor (instructionShoveDup state accessor)) @@ -206,7 +204,7 @@ instructionConj state primAccessor vectorAccessor = _ -> state -- v for vector, vs for vectorstack (also applicable to strings) --- Could abstract this unconsing even further +-- Could abstract this unconsing even further in all functions below instructionTakeN :: State -> Lens' State [[a]] -> State instructionTakeN state@(State {_int = i1 : is}) accessor = case uncons (view accessor state) of diff --git a/src/Instructions/IntInstructions.hs b/src/Instructions/IntInstructions.hs index a404028..a033a7f 100644 --- a/src/Instructions/IntInstructions.hs +++ b/src/Instructions/IntInstructions.hs @@ -88,43 +88,17 @@ instructionIntEq state = instructionEq state int instructionIntStackDepth :: State -> State instructionIntStackDepth state = instructionStackDepth state int --- int specific instructionIntYank :: State -> State --- instructionIntYank state = instructionYank state int -instructionIntYank state@(State {_int = rawIndex : i1 : is}) = - let - myIndex :: Int - myIndex = max 0 (min rawIndex (length is - 1)) - in - state {_int = is !! myIndex : i1 : deleteAt myIndex is} -instructionIntYank state = state +instructionIntYank state = instructionYank state int instructionIntYankDup :: State -> State -instructionIntYankDup state@(State {_int = rawIndex : item : is}) = - let - myIndex :: Int - myIndex = max 0 (min rawIndex (length is - 1)) - in - state {_int = is !! myIndex : item : is} -instructionIntYankDup state = state +instructionIntYankDup state = instructionYankDup state int instructionIntShove :: State -> State -instructionIntShove state@(State {_int = rawIndex : item : is}) = - let - myIndex :: Int - myIndex = max 0 (min rawIndex (length is - 1)) - in - state {_int = combineTuple item (splitAt myIndex is)} -instructionIntShove state = state +instructionIntShove state = instructionShove state int instructionIntShoveDup :: State -> State -instructionIntShoveDup state@(State {_int = rawIndex : item : is}) = - let - myIndex :: Int - myIndex = max 0 (min rawIndex (length is - 1)) - in - state {_int = item : combineTuple item (splitAt myIndex is)} -instructionIntShoveDup state = state +instructionIntShoveDup state = instructionShoveDup state int instructionIntIsEmpty :: State -> State instructionIntIsEmpty state = instructionIsEmpty state int diff --git a/src/Instructions/StringInstructions.hs b/src/Instructions/StringInstructions.hs index 0c7073a..c26aada 100644 --- a/src/Instructions/StringInstructions.hs +++ b/src/Instructions/StringInstructions.hs @@ -94,8 +94,6 @@ 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 = instructionVectorContains state char string instructionStringIndexOfChar :: State -> State diff --git a/src/Push.hs b/src/Push.hs index 2d3ebd2..035453f 100644 --- a/src/Push.hs +++ b/src/Push.hs @@ -64,7 +64,7 @@ interpretExec state@(State {_exec = e : es}) = (StateFunc func) -> interpretExec $ func state {_exec = es} (Block block) -> interpretExec (state {_exec = block ++ es}) (PlaceInput val) -> interpretExec (state {_exec = (view input state Map.! val) : es}) - Close -> undefined -- remove Close constructor later? + Close -> undefined -- This should be removed later. Will be converted to Blocks in the Plushy -> Exec stack process interpretExec state = state -- Need to make interpretExec strict, right? diff --git a/test/Main.hs b/test/Main.hs index 6104e91..b88073e 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -68,8 +68,8 @@ main = do intTestFunc "instructionIntStackDepth" [2, 51, 52] [GeneInt 52, GeneInt 51, StateFunc instructionIntStackDepth] emptyState intTestFunc "instructionIntYank" [3, 3, 2, 1] [GeneInt 3, GeneInt 1, GeneInt 2, GeneInt 3, GeneInt 4, StateFunc instructionIntYank] emptyState intTestFunc "instructionIntYankDup" [3, 3, 2, 1, 3] [GeneInt 3, GeneInt 1, GeneInt 2, GeneInt 3, GeneInt 4, StateFunc instructionIntYankDup] emptyState - intTestFunc "instructionIntShove" [2, 1, 3, 1] [GeneInt 1, GeneInt 1, GeneInt 2, GeneInt 3, GeneInt 2, StateFunc instructionIntShove] emptyState - intTestFunc "instructionIntShoveDup" [3, 2, 1, 3, 1] [GeneInt 1, GeneInt 1, GeneInt 2, GeneInt 3, GeneInt 2, StateFunc instructionIntShoveDup] emptyState + intTestFunc "instructionIntShove" [2, 3, 1, 1] [GeneInt 1, GeneInt 1, GeneInt 2, GeneInt 3, GeneInt 2, StateFunc instructionIntShove] emptyState + intTestFunc "instructionIntShoveDup" [3, 2, 3, 1, 1] [GeneInt 1, GeneInt 1, GeneInt 2, GeneInt 3, GeneInt 2, StateFunc instructionIntShoveDup] emptyState -- Exec tests intTestFunc "instructionExecIf" [6, 5] [GeneBool True, StateFunc instructionExecIf, Block [GeneInt 5, GeneInt 6], Block [GeneInt 7, GeneInt 8]] emptyState