never executed always true always false

    1 module HelVM.HelMA.Automata.Piet.Types.Memory
    2   ( Memory (..)
    3   , Stack
    4   , initialMemory
    5   , instructionMemory
    6   , orientationMemory
    7   , positionMemory
    8   , programMemory
    9   , setInstructionCounter
   10   , stack
   11   , stepWhitePixel
   12   ) where
   13 
   14 import           HelVM.HelMA.Automata.Piet.Types.CodelChooser
   15 import           HelVM.HelMA.Automata.Piet.Types.Coordinates
   16 import           HelVM.HelMA.Automata.Piet.Types.DirectionPointer
   17 import           HelVM.HelMA.Automata.Piet.Types.InstructionCounter
   18 import           HelVM.HelMA.Automata.Piet.Types.InstructionMemory
   19 import           HelVM.HelMA.Automata.Piet.Types.Orientation
   20 import           HelVM.HelMA.Automata.Piet.Types.Program
   21 
   22 import qualified Data.Sequence                                      as Seq
   23 
   24 import           Lens.Micro                                         ( (.~), (^.) )
   25 import           Lens.Micro.TH                                      ( makeLenses )
   26 
   27 import           Prelude                                            hiding ( empty )
   28 
   29 data Memory
   30   = Memory
   31       { _instructionMemory :: !InstructionMemory
   32       , _stack             :: !Stack
   33       }
   34 
   35 type Stack = Seq.Seq Int
   36 
   37 makeLenses ''Memory
   38 
   39 stepWhitePixel ∷ Memory → Memory
   40 stepWhitePixel mem = handleBlocked (isBlocked nextPos prog) nextPos dp mem where
   41   prog    = programMemory mem
   42   nextPos = addCoordinates dp $ positionMemory mem
   43   dp      = directionPointerMemory mem
   44 
   45 -- INITIALIZERS & CONSTRUCTORS
   46 
   47 initialMemory ∷ Program → Memory
   48 initialMemory prog = Memory
   49   { _instructionMemory = initialInstructionMemory prog
   50   , _stack             = Seq.empty
   51   }
   52 
   53 -- GETTERS
   54 
   55 programMemory ∷ Memory → Program
   56 programMemory mem = mem ^. instructionMemory . program
   57 
   58 instructionCounterMemory ∷ Memory → InstructionCounter
   59 instructionCounterMemory mem = mem ^. instructionMemory . instructionCounter
   60 
   61 directionPointerMemory ∷ Memory → DirectionPointer
   62 directionPointerMemory mem = orientationMemory mem ^. directionPointer
   63 
   64 codelChooserMemory ∷ Memory → CodelChooser
   65 codelChooserMemory mem = orientationMemory mem ^. codelChooser
   66 
   67 positionMemory ∷ Memory → Coordinates
   68 positionMemory mem = instructionCounterMemory mem ^. position
   69 
   70 orientationMemory ∷ Memory → Orientation
   71 orientationMemory mem = instructionCounterMemory mem ^. orientation
   72 
   73 -- SETTERS
   74 
   75 setInstructionCounter ∷ InstructionCounter → Memory → Memory
   76 setInstructionCounter ic = instructionMemory . instructionCounter .~ ic
   77 
   78 setPosition ∷ Coordinates → Memory → Memory
   79 setPosition pos = instructionMemory . instructionCounter . position .~ pos
   80 
   81 setDirectionPointer ∷ DirectionPointer → Memory → Memory
   82 setDirectionPointer dp = instructionMemory . instructionCounter . orientation . directionPointer .~ dp
   83 
   84 setCodelChooser ∷ CodelChooser → Memory → Memory
   85 setCodelChooser cc = instructionMemory . instructionCounter . orientation . codelChooser .~ cc
   86 
   87 -- OPERATIONS & MODIFIERS
   88 
   89 handleBlocked ∷ Bool → Coordinates → DirectionPointer → Memory → Memory
   90 handleBlocked True  _       dp = rotateAndToggle dp
   91 handleBlocked False nextPos _  = setPosition nextPos
   92 
   93 rotateAndToggle ∷ DirectionPointer → Memory → Memory
   94 rotateAndToggle dp mem = setCodelChooser (toggle 1 (codelChooserMemory mem)) $ setDirectionPointer (rotate 1 dp) mem