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 (i                                : il) = i                              : f il
   40   optimize _                                     []  = []
   41 
   42 optimizeImmediateBinary :: Integer -> BinaryOperation -> InstructionList
   43 optimizeImmediateBinary 0 Sub = []
   44 optimizeImmediateBinary 0 Add = []
   45 optimizeImmediateBinary 1 Mul = []
   46 optimizeImmediateBinary i op  = [immediateBinaryI i op]
   47 
   48 optimizeHalibut :: Integer -> Instruction
   49 optimizeHalibut i
   50   | 0 < i     = moveII $ fromIntegral i
   51   | otherwise = copyII $ fromIntegral $ negate i
   52 
   53 optimizePick :: Integer -> Instruction
   54 optimizePick i
   55   | 0 <= i    = copyII $ fromIntegral i
   56   | otherwise = moveII $ fromIntegral $ negate i
   57 
   58 optimizeBranch :: BranchTest -> Integer -> Integer -> InstructionList
   59 optimizeBranch t c a = check $ isJump t c where
   60   check True = [jumpII $ fromIntegral a]
   61   check _    = []
   62 
   63 optimizeBranchLabel :: BranchTest -> Integer -> InstructionList
   64 optimizeBranchLabel t a = [branchI t $ fromIntegral a]
   65 
   66 optimizeBranchCondition :: Index -> BranchTest -> Integer -> InstructionList
   67 optimizeBranchCondition 1 t c = optimizeBranchCondition1 t c
   68 optimizeBranchCondition i t c = check $ isJump t c where
   69   check True = [moveII1 , jumpTI]
   70   check _    = [moveII1 , discardI]
   71   moveII1 = moveII (i - 1)
   72 
   73 optimizeBranchCondition1 :: BranchTest -> Integer -> InstructionList
   74 optimizeBranchCondition1 t c = check $ isJump t c where
   75   check True = [jumpTI]
   76   check _    = [discardI]
   77 
   78 copyAdd :: Index -> [Instruction]
   79 copyAdd 0 = []
   80 copyAdd i = [copyII (i - 1) , addI]
   81 
   82 moveAdd :: Index -> [Instruction]
   83 moveAdd 0 = []
   84 moveAdd 1 = [addI]
   85 moveAdd i = [moveII (i - 1) , addI]
   86 
   87 optimizeStoreID :: Integer -> Integer -> Instruction
   88 optimizeStoreID v = storeIDI v . fromIntegral
   89 
   90 optimizeLoadD :: Integer -> Instruction
   91 optimizeLoadD = loadDI . fromIntegral
   92 
   93 optimizeMoveD :: Index -> Integer -> Instruction
   94 optimizeMoveD s d = moveDI s (fromIntegral d)