never executed always true always false

    1 module HelVM.HelMA.Automaton.Optimizer.PeepholeOptimizer (
    2   peepholeOptimize,
    3 ) where
    4 
    5 import           HelVM.HelMA.Automaton.Instruction
    6 
    7 import           HelVM.HelMA.Automaton.Instruction.Extras.Common
    8 import           HelVM.HelMA.Automaton.Instruction.Extras.Constructors
    9 import           HelVM.HelMA.Automaton.Instruction.Extras.Patterns
   10 
   11 import           HelVM.HelMA.Automaton.Instruction.Groups.CFInstruction
   12 import           HelVM.HelMA.Automaton.Instruction.Groups.SMInstruction
   13 
   14 peepholeOptimize :: InstructionList -> InstructionList
   15 peepholeOptimize = peepholeOptimize2 . peepholeOptimize1
   16 
   17 peepholeOptimize1 :: InstructionList -> InstructionList
   18 peepholeOptimize1 = fix optimize where
   19   optimize :: (InstructionList -> InstructionList) -> InstructionList -> InstructionList
   20   optimize f (ConsP i : BinaryP op           : il) = optimizeImmediateBinary i op <> f il
   21   optimize f (ConsP i : HalibutP             : il) = optimizeHalibut i             : f il
   22   optimize f (ConsP i : PickP                : il) = optimizePick i                : f il
   23   optimize f (ConsP c : ConsP a : BranchTP t : il) = optimizeBranch t c a         <> f il
   24   optimize f (ConsP a : BranchTP t           : il) = optimizeBranchLabel t a      <> f il
   25   optimize f (ConsP a : ConsP v : StoreP     : il) = optimizeStoreID v a           : f il
   26   optimize f (ConsP a : LoadP                : il) = optimizeLoadD a               : f il
   27   optimize f (i                              : il) = i                             : f il
   28   optimize _                                   []  = []
   29 
   30 peepholeOptimize2 :: InstructionList -> InstructionList
   31 peepholeOptimize2 = fix optimize where
   32   optimize :: (InstructionList -> InstructionList) -> InstructionList -> InstructionList
   33   optimize f (ConsP c : MoveIP i : BranchTP t  : il) = optimizeBranchCondition i t c <> f il
   34   optimize f (MoveIP 1 : BranchTP t            : il) = branchSwapI t                  : f il
   35   optimize f (ConsP 0 : CopyIP i : SubP : SubP : il) = copyAdd i                     <> f il
   36   optimize f (ConsP 0 : MoveIP i : SubP : SubP : il) = moveAdd i                     <> f il
   37   optimize f (BNeIP i : SubP                   : il) = [bNeII i , discardI]          <> f il
   38   optimize f (ConsP d : LoadDP s : StoreP      : il) = optimizeMoveD s d              : f il
   39   optimize f (AddIP i1 : AddIP i2              : il) = optimizeAddIP i1 i2            : f il
   40   optimize f (i                                : il) = i                              : f il
   41   optimize _                                     []  = []
   42 
   43 optimizeImmediateBinary :: Integer -> BinaryOperation -> InstructionList
   44 optimizeImmediateBinary 0 Sub = []
   45 optimizeImmediateBinary 0 Add = []
   46 optimizeImmediateBinary 1 Mul = []
   47 optimizeImmediateBinary i op  = [immediateBinaryI i op]
   48 
   49 optimizeHalibut :: Integer -> Instruction
   50 optimizeHalibut i
   51   | 0 < i     = moveII $ fromIntegral i
   52   | otherwise = copyII $ fromIntegral $ negate i
   53 
   54 optimizePick :: Integer -> Instruction
   55 optimizePick i
   56   | 0 <= i    = copyII $ fromIntegral i
   57   | otherwise = moveII $ fromIntegral $ negate i
   58 
   59 optimizeBranch :: BranchTest -> Integer -> Integer -> InstructionList
   60 optimizeBranch t c a = check $ isJump t c where
   61   check True = [jumpII $ fromIntegral a]
   62   check _    = []
   63 
   64 optimizeBranchLabel :: BranchTest -> Integer -> InstructionList
   65 optimizeBranchLabel t a = [branchI t $ fromIntegral a]
   66 
   67 optimizeBranchCondition :: ImmediateIndex -> BranchTest -> Integer -> InstructionList
   68 optimizeBranchCondition 1 t c = optimizeBranchCondition1 t c
   69 optimizeBranchCondition i t c = check $ isJump t c where
   70   check True = [moveII1 , jumpTI]
   71   check _    = [moveII1 , discardI]
   72   moveII1 = moveII (i - 1)
   73 
   74 optimizeBranchCondition1 :: BranchTest -> Integer -> InstructionList
   75 optimizeBranchCondition1 t c = check $ isJump t c where
   76   check True = [jumpTI]
   77   check _    = [discardI]
   78 
   79 copyAdd :: ImmediateIndex -> [Instruction]
   80 copyAdd 0 = []
   81 copyAdd i = [copyII (i - 1) , addI]
   82 
   83 moveAdd :: ImmediateIndex -> [Instruction]
   84 moveAdd 0 = []
   85 moveAdd 1 = [addI]
   86 moveAdd i = [moveII (i - 1) , addI]
   87 
   88 optimizeStoreID :: Integer -> Integer -> Instruction
   89 optimizeStoreID v = storeIDI v . fromIntegral
   90 
   91 optimizeLoadD :: Integer -> Instruction
   92 optimizeLoadD = loadDI . fromIntegral
   93 
   94 optimizeMoveD :: ImmediateIndex -> Integer -> Instruction
   95 optimizeMoveD s d = moveDI s (fromIntegral d)
   96 
   97 optimizeAddIP :: Integer -> Integer -> Instruction
   98 optimizeAddIP i1 i2 = immediateBinaryI (i1 + i2) Add