Merge branch 'vectors_code' into learn_quickcheck

merge vectors_code into learn_quickcheck

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

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

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

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

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?

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