never executed always true always false

    1 module HelVM.HelMA.Automata.BrainFuck.Impl.Fast.Optimizer (
    2   optimize,
    3 ) where
    4 
    5 import           HelVM.HelMA.Automata.BrainFuck.Impl.Fast.Instruction
    6 
    7 optimize :: FastInstructionList -> FastInstructionList
    8 optimize  (Move s1 : Move s2 : il) = optimize (Move (s1 + s2) : il)
    9 optimize  (Inc  s1 : Inc  s2 : il) = optimize (Inc  (s1 + s2) : il)
   10 optimize ((While [Inc (-1)]) : il) = buildClear il
   11 optimize ((While [Inc   1 ]) : il) = buildClear il
   12 optimize        ((While il') : il) = buildWhile (optimize il') : optimize il
   13 optimize                  (i : il) = i : optimize il
   14 optimize                       []  = []
   15 
   16 buildClear :: FastInstructionList -> FastInstructionList
   17 buildClear = optimizeSet . optimize
   18 
   19 optimizeSet :: FastInstructionList -> FastInstructionList
   20 optimizeSet (Inc s : il) = Set s : il
   21 optimizeSet          il  = Set 0 : il
   22 
   23 buildWhile :: FastInstructionList -> FastInstruction
   24 buildWhile [Move forward , Inc mul , Move back , Inc (-1)]                              = buildAdd back forward mul
   25 buildWhile [Inc (-1) , Move forward , Inc mul , Move back]                              = buildAdd back forward mul
   26 buildWhile [Move f1 , Inc m1 , Move f2 , Inc m2 , Move back , Inc (-1)]                 = buildDup back f1 f2 m1 m2
   27 buildWhile [Inc (-1) , Move f1 , Inc m1 , Move f2 , Inc m2 , Move back]                 = buildDup back f1 f2 m1 m2
   28 buildWhile [Move f1 , Inc 1 , Move f2 , Inc 1 , Move f3 , Inc 1 , Move back , Inc (-1)] = buildTri back f1 f2 f3
   29 buildWhile [Inc (-1) , Move f1 , Inc 1 , Move f2 , Inc 1 , Move f3 , Inc 1 , Move back] = buildTri back f1 f2 f3
   30 buildWhile il                                                                           = While il
   31 
   32 buildAdd :: Integer -> Integer -> Integer -> FastInstruction
   33 buildAdd back forward = build (negate back == forward) where
   34   build True  (-1) = SubClr        forward
   35   build True    1  = AddClr        forward
   36   build True  mul  = MulAddClr mul forward
   37   build False mul  = While [Move forward , Inc mul , Move back , Inc (-1)]
   38 
   39 buildDup :: Integer -> Integer -> Integer -> Integer -> Integer -> FastInstruction
   40 buildDup back f1 f2 = build (negate back == f1 + f2) where
   41   build True   1  1 = DupClr          f1 f2
   42   build True  m1 m2 = MulDupClr m1 m2 f1 f2
   43   build False m1 m2 = While [Move f1 , Inc m1 , Move f2 , Inc m2 , Move back , Inc (-1)]
   44 
   45 buildTri :: Integer -> Integer -> Integer -> Integer -> FastInstruction
   46 buildTri back f1 f2 f3
   47   | f1 + f2 + f3 == negate back = TriClr f1 f2 f3
   48   | otherwise = While [Move f1 , Inc 1 , Move f2 , Inc 1 , Move f3 , Inc 1 , Move back , Inc (-1)]