From 63e9cff55ed8cf70924fdd23f96850d381f4c3cb Mon Sep 17 00:00:00 2001 From: Rowan Torbitzky-Lane Date: Wed, 29 Jan 2025 23:43:05 -0600 Subject: [PATCH] finish up the instructions --- src/Instructions/CharInstructions.hs | 39 ++++++++++ src/Instructions/CodeInstructions.hs | 76 ++++++++++++++++++- src/Instructions/ExecInstructions.hs | 15 ++++ src/Instructions/FloatInstructions.hs | 3 + src/Instructions/GenericInstructions.hs | 9 +++ src/Instructions/IntInstructions.hs | 3 + src/Instructions/LogicalInstructions.hs | 40 ++++++++++ src/Instructions/StringInstructions.hs | 36 +++++++++ src/Instructions/VectorCharInstructions.hs | 39 ++++++++++ src/Instructions/VectorFloatInstructions.hs | 39 ++++++++++ src/Instructions/VectorIntInstructions.hs | 39 ++++++++++ src/Instructions/VectorLogicalInstructions.hs | 39 ++++++++++ src/Instructions/VectorStringInstructions.hs | 39 ++++++++++ 13 files changed, 413 insertions(+), 3 deletions(-) diff --git a/src/Instructions/CharInstructions.hs b/src/Instructions/CharInstructions.hs index 7d4d94d..29fcdd9 100644 --- a/src/Instructions/CharInstructions.hs +++ b/src/Instructions/CharInstructions.hs @@ -48,3 +48,42 @@ instructionCharFromAsciiFloat state = state instructionCharsFromString :: State -> State instructionCharsFromString state@(State {_char = cs, _string = s1 : ss}) = state{_char = s1 <> cs, _string = ss} instructionCharsFromString state = state + +instructionCharPop :: State -> State +instructionCharPop state = instructionPop state char + +instructionCharDup :: State -> State +instructionCharDup state = instructionDup state char + +instructionCharDupN :: State -> State +instructionCharDupN state = instructionDupN state char + +instructionCharSwap :: State -> State +instructionCharSwap state = instructionSwap state char + +instructionCharRot :: State -> State +instructionCharRot state = instructionRot state char + +instructionCharFlush :: State -> State +instructionCharFlush state = instructionFlush state char + +instructionCharEq :: State -> State +instructionCharEq state = instructionEq state char + +instructionCharStackDepth :: State -> State +instructionCharStackDepth state = instructionStackDepth state char + +instructionCharYank :: State -> State +instructionCharYank state = instructionYank state char + +instructionCharYankDup :: State -> State +instructionCharYankDup state = instructionYankDup state char + +instructionCharIsEmpty :: State -> State +instructionCharIsEmpty state = instructionIsEmpty state char + +instructionCharShove :: State -> State +instructionCharShove state = instructionShove state char + +instructionCharShoveDup :: State -> State +instructionCharShoveDup state = instructionShoveDup state char diff --git a/src/Instructions/CodeInstructions.hs b/src/Instructions/CodeInstructions.hs index a88626d..54cc8de 100644 --- a/src/Instructions/CodeInstructions.hs +++ b/src/Instructions/CodeInstructions.hs @@ -4,6 +4,7 @@ import Data.List (elemIndex) import State import Instructions.GenericInstructions import Instructions.IntInstructions +import Control.Lens -- import Debug.Trace @@ -75,9 +76,9 @@ codeRecursiveSize _ = 1 instructionCodePop :: State -> State instructionCodePop state = instructionPop state code -instructionCodeFromExec :: State -> State -instructionCodeFromExec state@(State {_exec = (e1 : es), _code = cs}) = state {_exec = es, _code = e1 : cs} -instructionCodeFromExec state = state +-- instructionCodeFromExec :: State -> State +-- instructionCodeFromExec state@(State {_exec = (e1 : es), _code = cs}) = state {_exec = es, _code = e1 : cs} +-- instructionCodeFromExec state = state instructionCodeIsCodeBlock :: State -> State instructionCodeIsCodeBlock state@(State {_code = (c : cs), _bool = bs}) = state {_code = cs, _bool = isBlock c : bs} @@ -244,3 +245,72 @@ instructionCodeFirstPosition state = state instructionCodeReverse :: State -> State instructionCodeReverse state@(State {_code = (Block c1) : cs}) = state {_code = Block (reverse c1) : cs} instructionCodeReverse state = state + +instructionCodeDup :: State -> State +instructionCodeDup state = instructionDup state code + +instructionCodeDupN :: State -> State +instructionCodeDupN state = instructionDupN state code + +instructionCodeSwap :: State -> State +instructionCodeSwap state = instructionSwap state code + +instructionCodeRot :: State -> State +instructionCodeRot state = instructionRot state code + +instructionCodeFlush :: State -> State +instructionCodeFlush state = instructionFlush state code + +instructionCodeEq :: State -> State +instructionCodeEq state = instructionEq state code + +instructionCodeStackDepth :: State -> State +instructionCodeStackDepth state = instructionStackDepth state code + +instructionCodeYank :: State -> State +instructionCodeYank state = instructionYank state code + +instructionCodeYankDup :: State -> State +instructionCodeYankDup state = instructionYankDup state code + +instructionCodeStackIsEmpty :: State -> State +instructionCodeStackIsEmpty state = instructionIsEmpty state code + +instructionCodeShove :: State -> State +instructionCodeShove state = instructionShove state code + +instructionCodeShoveDup :: State -> State +instructionCodeShoveDup state = instructionShoveDup state code + +instructionCodeFromBool :: State -> State +instructionCodeFromBool state = instructionCodeFrom state bool GeneBool + +instructionCodeFromInt :: State -> State +instructionCodeFromInt state = instructionCodeFrom state int GeneInt + +instructionCodeFromChar :: State -> State +instructionCodeFromChar state = instructionCodeFrom state char GeneChar + +instructionCodeFromFloat :: State -> State +instructionCodeFromFloat state = instructionCodeFrom state float GeneFloat + +instructionCodeFromString :: State -> State +instructionCodeFromString state = instructionCodeFrom state string GeneString + +instructionCodeFromVectorInt :: State -> State +instructionCodeFromVectorInt state = instructionCodeFrom state vectorInt GeneVectorInt + +instructionCodeFromVectorFloat :: State -> State +instructionCodeFromVectorFloat state = instructionCodeFrom state vectorFloat GeneVectorFloat + +instructionCodeFromVectorString :: State -> State +instructionCodeFromVectorString state = instructionCodeFrom state vectorString GeneVectorString + +instructionCodeFromVectorBool :: State -> State +instructionCodeFromVectorBool state = instructionCodeFrom state vectorBool GeneVectorBool + +instructionCodeFromVectorChar :: State -> State +instructionCodeFromVectorChar state = instructionCodeFrom state vectorChar GeneVectorChar + +instructionCodeFromExec :: State -> State +instructionCodeFromExec state = instructionCodeFrom state exec id diff --git a/src/Instructions/ExecInstructions.hs b/src/Instructions/ExecInstructions.hs index 4177292..9b6357a 100644 --- a/src/Instructions/ExecInstructions.hs +++ b/src/Instructions/ExecInstructions.hs @@ -35,6 +35,21 @@ instructionExecEq state = instructionEq state exec instructionExecStackDepth :: State -> State instructionExecStackDepth state = instructionStackDepth state exec +instructionExecYank :: State -> State +instructionExecYank state = instructionYank state exec + +instructionExecYankDup :: State -> State +instructionExecYankDup state = instructionYankDup state exec + +instructionExecShove :: State -> State +instructionExecShove state = instructionShove state exec + +instructionExecShoveDup :: State -> State +instructionExecShoveDup state = instructionShoveDup state exec + +instructionExecIsEmpty :: State -> State +instructionExecIsEmpty state = instructionIsEmpty state exec + instructionExecDoRange :: State -> State instructionExecDoRange state@(State {_exec = (e1 : es), _int = (i0 : i1 : is)}) = if increment i0 i1 /= 0 diff --git a/src/Instructions/FloatInstructions.hs b/src/Instructions/FloatInstructions.hs index ede4a47..3891ed1 100644 --- a/src/Instructions/FloatInstructions.hs +++ b/src/Instructions/FloatInstructions.hs @@ -100,6 +100,9 @@ instructionFloatShoveDup state = instructionShoveDup state float instructionFloatShove :: State -> State instructionFloatShove state = instructionShove state float +instructionFloatIsEmpty :: State -> State +instructionFloatIsEmpty state = instructionIsEmpty state float + instructionFloatSin :: State -> State instructionFloatSin state@(State {_float = f1 : fs}) = state {_float = sin f1 : fs} instructionFloatSin state = state diff --git a/src/Instructions/GenericInstructions.hs b/src/Instructions/GenericInstructions.hs index 89bcd4d..546e6e3 100644 --- a/src/Instructions/GenericInstructions.hs +++ b/src/Instructions/GenericInstructions.hs @@ -90,6 +90,9 @@ instructionDup state accessor = instructionPop :: State -> Lens' State [a] -> State instructionPop state accessor = state & accessor .~ drop 1 (view accessor state) +instructionIsEmpty :: State -> Lens' State [a] -> State +instructionIsEmpty state@(State {_bool = bs}) accessor = state{_bool = null (view accessor state) : bs} + -- instructionPop :: State -> Lens' State [a] -> State -- instructionPop state accessor = if notEmptyStack state accessor then instructionPop state accessor else state @@ -336,3 +339,9 @@ instructionVectorIterate state@(State {_exec = e1 : es}) primAccessor vectorAcce _ -> state) -- This should never happen _ -> state instructionVectorIterate state _ _ _ _ = state + +instructionCodeFrom :: State -> Lens' State [a] -> (a -> Gene) -> State +instructionCodeFrom state@(State {_code = cs}) accessor geneType = + case uncons (view accessor state) of + Just (x, xs) -> state{_code = geneType x : cs} & accessor .~ xs + _ -> state diff --git a/src/Instructions/IntInstructions.hs b/src/Instructions/IntInstructions.hs index bdbc783..a404028 100644 --- a/src/Instructions/IntInstructions.hs +++ b/src/Instructions/IntInstructions.hs @@ -125,3 +125,6 @@ instructionIntShoveDup state@(State {_int = rawIndex : item : is}) = in state {_int = item : combineTuple item (splitAt myIndex is)} instructionIntShoveDup state = state + +instructionIntIsEmpty :: State -> State +instructionIntIsEmpty state = instructionIsEmpty state int diff --git a/src/Instructions/LogicalInstructions.hs b/src/Instructions/LogicalInstructions.hs index e94b66e..a10e96f 100644 --- a/src/Instructions/LogicalInstructions.hs +++ b/src/Instructions/LogicalInstructions.hs @@ -1,6 +1,7 @@ module Instructions.LogicalInstructions where import State +import Instructions.GenericInstructions instructionBoolFromInt :: State -> State instructionBoolFromInt state@(State {_int = (i : is), _bool = bs}) = state {_int = is, _bool = (i /= 0) : bs} @@ -37,3 +38,42 @@ xor b1 b2 instructionBoolXor :: State -> State instructionBoolXor = boolTemplate xor + +instructionBoolPop :: State -> State +instructionBoolPop state = instructionPop state bool + +instructionBoolDup :: State -> State +instructionBoolDup state = instructionDup state bool + +instructionBoolDupN :: State -> State +instructionBoolDupN state = instructionDupN state bool + +instructionBoolSwap :: State -> State +instructionBoolSwap state = instructionSwap state bool + +instructionBoolRot :: State -> State +instructionBoolRot state = instructionRot state bool + +instructionBoolFlush :: State -> State +instructionBoolFlush state = instructionFlush state bool + +instructionBoolEq :: State -> State +instructionBoolEq state = instructionEq state bool + +instructionBoolStackDepth :: State -> State +instructionBoolStackDepth state = instructionStackDepth state bool + +instructionBoolYank :: State -> State +instructionBoolYank state = instructionYank state bool + +instructionBoolYankDup :: State -> State +instructionBoolYankDup state = instructionYankDup state bool + +instructionBoolShove :: State -> State +instructionBoolShove state = instructionShove state bool + +instructionBoolShoveDup :: State -> State +instructionBoolShoveDup state = instructionShoveDup state bool + +instructionBoolIsEmpty :: State -> State +instructionBoolIsEmpty state = instructionIsEmpty state bool diff --git a/src/Instructions/StringInstructions.hs b/src/Instructions/StringInstructions.hs index e828677..0c7073a 100644 --- a/src/Instructions/StringInstructions.hs +++ b/src/Instructions/StringInstructions.hs @@ -196,3 +196,39 @@ instructionStringFromFloat state = instructionStringFromLens state float instructionStringFromChar :: State -> State instructionStringFromChar state@(State {_string = ss, _char = c1 : cs}) = state{_string = [c1] : ss, _char = cs} instructionStringFromChar state = state + +instructionStringPop :: State -> State +instructionStringPop state = instructionPop state string + +instructionStringDup :: State -> State +instructionStringDup state = instructionDup state string + +instructionStringDupN :: State -> State +instructionStringDupN state = instructionDupN state string + +instructionStringRot :: State -> State +instructionStringRot state = instructionRot state string + +instructionStringFlush :: State -> State +instructionStringFlush state = instructionFlush state string + +instructionStringEq :: State -> State +instructionStringEq state = instructionEq state string + +instructionStringStackDepth :: State -> State +instructionStringStackDepth state = instructionStackDepth state string + +instructionStringYank :: State -> State +instructionStringYank state = instructionYank state string + +instructionStringYankDup :: State -> State +instructionStringYankDup state = instructionYankDup state string + +instructionStringIsEmpty :: State -> State +instructionStringIsEmpty state = instructionIsEmpty state string + +instructionStringShove :: State -> State +instructionStringShove state = instructionShove state string + +instructionStringShoveDup :: State -> State +instructionStringShoveDup state = instructionShoveDup state string diff --git a/src/Instructions/VectorCharInstructions.hs b/src/Instructions/VectorCharInstructions.hs index e0c6fd1..30c9d0b 100644 --- a/src/Instructions/VectorCharInstructions.hs +++ b/src/Instructions/VectorCharInstructions.hs @@ -65,3 +65,42 @@ instructionVectorCharRemove state = instructionVectorRemove state char vectorCha instructionVectorCharIterate :: State -> State instructionVectorCharIterate state = instructionVectorIterate state char vectorChar GeneVectorChar instructionVectorCharIterate + +instructionVectorCharPop :: State -> State +instructionVectorCharPop state = instructionPop state vectorChar + +instructionVectorCharDup :: State -> State +instructionVectorCharDup state = instructionDup state vectorChar + +instructionVectorCharDupN :: State -> State +instructionVectorCharDupN state = instructionDupN state vectorChar + +instructionVectorCharSwap :: State -> State +instructionVectorCharSwap state = instructionSwap state vectorChar + +instructionVectorCharRot :: State -> State +instructionVectorCharRot state = instructionRot state vectorChar + +instructionVectorCharFlush :: State -> State +instructionVectorCharFlush state = instructionFlush state vectorChar + +instructionVectorCharEq :: State -> State +instructionVectorCharEq state = instructionEq state vectorChar + +instructionVectorCharStackDepth :: State -> State +instructionVectorCharStackDepth state = instructionStackDepth state vectorChar + +instructionVectorCharYank :: State -> State +instructionVectorCharYank state = instructionYank state vectorChar + +instructionVectorCharYankDup :: State -> State +instructionVectorCharYankDup state = instructionYankDup state vectorChar + +instructionVectorCharStackIsEmpty :: State -> State +instructionVectorCharStackIsEmpty state = instructionIsEmpty state vectorChar + +instructionVectorCharShove :: State -> State +instructionVectorCharShove state = instructionShove state vectorChar + +instructionVectorCharShoveDup :: State -> State +instructionVectorCharShoveDup state = instructionShoveDup state vectorChar diff --git a/src/Instructions/VectorFloatInstructions.hs b/src/Instructions/VectorFloatInstructions.hs index 0006903..b45f2dc 100644 --- a/src/Instructions/VectorFloatInstructions.hs +++ b/src/Instructions/VectorFloatInstructions.hs @@ -65,3 +65,42 @@ instructionVectorFloatRemove state = instructionVectorRemove state float vectorF instructionVectorFloatIterate :: State -> State instructionVectorFloatIterate state = instructionVectorIterate state float vectorFloat GeneVectorFloat instructionVectorFloatIterate + +instructionVectorFloatPop :: State -> State +instructionVectorFloatPop state = instructionPop state vectorFloat + +instructionVectorFloatDup :: State -> State +instructionVectorFloatDup state = instructionDup state vectorFloat + +instructionVectorFloatDupN :: State -> State +instructionVectorFloatDupN state = instructionDupN state vectorFloat + +instructionVectorFloatSwap :: State -> State +instructionVectorFloatSwap state = instructionSwap state vectorFloat + +instructionVectorFloatRot :: State -> State +instructionVectorFloatRot state = instructionRot state vectorFloat + +instructionVectorFloatFlush :: State -> State +instructionVectorFloatFlush state = instructionFlush state vectorFloat + +instructionVectorFloatEq :: State -> State +instructionVectorFloatEq state = instructionEq state vectorFloat + +instructionVectorFloatStackDepth :: State -> State +instructionVectorFloatStackDepth state = instructionStackDepth state vectorFloat + +instructionVectorFloatYank :: State -> State +instructionVectorFloatYank state = instructionYank state vectorFloat + +instructionVectorFloatYankDup :: State -> State +instructionVectorFloatYankDup state = instructionYankDup state vectorFloat + +instructionVectorFloatStackIsEmpty :: State -> State +instructionVectorFloatStackIsEmpty state = instructionIsEmpty state vectorFloat + +instructionVectorFloatShove :: State -> State +instructionVectorFloatShove state = instructionShove state vectorFloat + +instructionVectorFloatShoveDup :: State -> State +instructionVectorFloatShoveDup state = instructionShoveDup state vectorFloat diff --git a/src/Instructions/VectorIntInstructions.hs b/src/Instructions/VectorIntInstructions.hs index 38c63a9..7bf3bf3 100644 --- a/src/Instructions/VectorIntInstructions.hs +++ b/src/Instructions/VectorIntInstructions.hs @@ -65,3 +65,42 @@ instructionVectorIntRemove state = instructionVectorRemove state int vectorInt instructionVectorIntIterate :: State -> State instructionVectorIntIterate state = instructionVectorIterate state int vectorInt GeneVectorInt instructionVectorIntIterate + +instructionVectorIntPop :: State -> State +instructionVectorIntPop state = instructionPop state vectorChar + +instructionVectorIntDup :: State -> State +instructionVectorIntDup state = instructionDup state vectorChar + +instructionVectorIntDupN :: State -> State +instructionVectorIntDupN state = instructionDupN state vectorChar + +instructionVectorIntSwap :: State -> State +instructionVectorIntSwap state = instructionSwap state vectorChar + +instructionVectorIntRot :: State -> State +instructionVectorIntRot state = instructionRot state vectorChar + +instructionVectorIntFlush :: State -> State +instructionVectorIntFlush state = instructionFlush state vectorChar + +instructionVectorIntEq :: State -> State +instructionVectorIntEq state = instructionEq state vectorChar + +instructionVectorIntStackDepth :: State -> State +instructionVectorIntStackDepth state = instructionStackDepth state vectorChar + +instructionVectorIntYank :: State -> State +instructionVectorIntYank state = instructionYank state vectorChar + +instructionVectorIntYankDup :: State -> State +instructionVectorIntYankDup state = instructionYankDup state vectorChar + +instructionVectorIntStackIsEmpty :: State -> State +instructionVectorIntStackIsEmpty state = instructionIsEmpty state vectorChar + +instructionVectorIntShove :: State -> State +instructionVectorIntShove state = instructionShove state vectorChar + +instructionVectorIntShoveDup :: State -> State +instructionVectorIntShoveDup state = instructionShoveDup state vectorChar diff --git a/src/Instructions/VectorLogicalInstructions.hs b/src/Instructions/VectorLogicalInstructions.hs index e9a4a3f..af5e0f5 100644 --- a/src/Instructions/VectorLogicalInstructions.hs +++ b/src/Instructions/VectorLogicalInstructions.hs @@ -65,3 +65,42 @@ instructionVectorBoolRemove state = instructionVectorRemove state bool vectorBoo instructionVectorBoolIterate :: State -> State instructionVectorBoolIterate state = instructionVectorIterate state bool vectorBool GeneVectorBool instructionVectorBoolIterate + +instructionVectorBoolPop :: State -> State +instructionVectorBoolPop state = instructionPop state vectorBool + +instructionVectorBoolDup :: State -> State +instructionVectorBoolDup state = instructionDup state vectorBool + +instructionVectorBoolDupN :: State -> State +instructionVectorBoolDupN state = instructionDupN state vectorBool + +instructionVectorBoolSwap :: State -> State +instructionVectorBoolSwap state = instructionSwap state vectorBool + +instructionVectorBoolRot :: State -> State +instructionVectorBoolRot state = instructionRot state vectorBool + +instructionVectorBoolFlush :: State -> State +instructionVectorBoolFlush state = instructionFlush state vectorBool + +instructionVectorBoolEq :: State -> State +instructionVectorBoolEq state = instructionEq state vectorBool + +instructionVectorBoolStackDepth :: State -> State +instructionVectorBoolStackDepth state = instructionStackDepth state vectorBool + +instructionVectorBoolYank :: State -> State +instructionVectorBoolYank state = instructionYank state vectorBool + +instructionVectorBoolYankDup :: State -> State +instructionVectorBoolYankDup state = instructionYankDup state vectorBool + +instructionVectorBoolStackIsEmpty :: State -> State +instructionVectorBoolStackIsEmpty state = instructionIsEmpty state vectorBool + +instructionVectorBoolShove :: State -> State +instructionVectorBoolShove state = instructionShove state vectorBool + +instructionVectorBoolShoveDup :: State -> State +instructionVectorBoolShoveDup state = instructionShoveDup state vectorBool diff --git a/src/Instructions/VectorStringInstructions.hs b/src/Instructions/VectorStringInstructions.hs index 23ec76f..ee524d6 100644 --- a/src/Instructions/VectorStringInstructions.hs +++ b/src/Instructions/VectorStringInstructions.hs @@ -65,3 +65,42 @@ instructionVectorStringRemove state = instructionVectorRemove state string vecto instructionVectorStringIterate :: State -> State instructionVectorStringIterate state = instructionVectorIterate state string vectorString GeneVectorString instructionVectorStringIterate + +instructionVectorStringPop :: State -> State +instructionVectorStringPop state = instructionPop state vectorString + +instructionVectorStringDup :: State -> State +instructionVectorStringDup state = instructionDup state vectorString + +instructionVectorStringDupN :: State -> State +instructionVectorStringDupN state = instructionDupN state vectorString + +instructionVectorStringSwap :: State -> State +instructionVectorStringSwap state = instructionSwap state vectorString + +instructionVectorStringRot :: State -> State +instructionVectorStringRot state = instructionRot state vectorString + +instructionVectorStringFlush :: State -> State +instructionVectorStringFlush state = instructionFlush state vectorString + +instructionVectorStringEq :: State -> State +instructionVectorStringEq state = instructionEq state vectorString + +instructionVectorStringStackDepth :: State -> State +instructionVectorStringStackDepth state = instructionStackDepth state vectorString + +instructionVectorStringYank :: State -> State +instructionVectorStringYank state = instructionYank state vectorString + +instructionVectorStringYankDup :: State -> State +instructionVectorStringYankDup state = instructionYankDup state vectorString + +instructionVectorStringStackIsEmpty :: State -> State +instructionVectorStringStackIsEmpty state = instructionIsEmpty state vectorString + +instructionVectorStringShove :: State -> State +instructionVectorStringShove state = instructionShove state vectorString + +instructionVectorStringShoveDup :: State -> State +instructionVectorStringShoveDup state = instructionShoveDup state vectorString