never executed always true always false

    1 {-# LANGUAGE PatternSynonyms #-}
    2 module HelVM.HelMA.Automaton.Instruction.Extras.Patterns where
    3 
    4 import           HelVM.HelMA.Automaton.Instruction.Extras.Common
    5 import           HelVM.HelMA.Automaton.Instruction.Groups.CFInstruction
    6 import           HelVM.HelMA.Automaton.Instruction.Groups.LSInstruction
    7 import           HelVM.HelMA.Automaton.Instruction.Groups.SMInstruction
    8 
    9 import           HelVM.HelMA.Automaton.Instruction
   10 
   11 -- | Getters
   12 
   13 isICF :: Instruction -> Bool
   14 isICF (ICF _) = True
   15 isICF      _  = False
   16 
   17 isMark :: Instruction -> Bool
   18 isMark (MarkP _) = True
   19 isMark        _  = False
   20 
   21 checkNaturalMark :: Natural -> Instruction -> Bool
   22 checkNaturalMark n (MNaturalP n') = n == n'
   23 checkNaturalMark _            _   = False
   24 
   25 checkArtificialMark :: Label -> Instruction -> Bool
   26 checkArtificialMark l (MArtificialP l') = l == l'
   27 checkArtificialMark _               _   = False
   28 
   29 -- | Patterns
   30 
   31 -- | ISM
   32 
   33 pattern SubP :: Instruction
   34 pattern SubP = ISM (SPure (Binary Sub))
   35 
   36 pattern HalibutP :: Instruction
   37 pattern HalibutP = ISM (SPure Halibut)
   38 
   39 pattern PickP :: Instruction
   40 pattern PickP = ISM (SPure Pick)
   41 
   42 pattern ConsP :: Integer -> Instruction
   43 pattern ConsP c = ISM (SPure (Cons c))
   44 
   45 pattern CopyIP :: Index -> Instruction
   46 pattern CopyIP i = ISM (SPure (Indexed (IImmediate i) Copy))
   47 
   48 pattern MoveIP :: Index -> Instruction
   49 pattern MoveIP i = ISM (SPure (Indexed (IImmediate i) Move))
   50 
   51 pattern BinaryP :: BinaryOperation -> Instruction
   52 pattern BinaryP op = ISM (SPure (Binary op))
   53 
   54 pattern SPureP :: SPureInstruction -> Instruction
   55 pattern SPureP i = ISM (SPure i)
   56 
   57 -- | ICF
   58 
   59 pattern BNeIP :: Natural -> Instruction
   60 pattern BNeIP i = ICF (Branch (BImmediate i) NE)
   61 
   62 pattern JumpP :: LabelOperand -> Instruction
   63 pattern JumpP o = ICF (Labeled o Jump)
   64 
   65 pattern MarkP :: Mark -> Instruction
   66 pattern MarkP m = ICF (Mark m)
   67 
   68 pattern MNaturalP :: Natural -> Instruction
   69 pattern MNaturalP n = ICF (Mark (MNatural n))
   70 
   71 pattern MArtificialP :: Label -> Instruction
   72 pattern MArtificialP l = ICF (Mark (MArtificial l))
   73 
   74 pattern BranchTP :: BranchTest -> Instruction
   75 pattern BranchTP t = ICF (Branch BTop t)
   76 
   77 -- | ILS
   78 
   79 pattern StoreP :: Instruction
   80 pattern StoreP = ILS Store
   81 
   82 pattern LoadP :: Instruction
   83 pattern LoadP = ILS Load
   84 
   85 pattern LoadDP :: Index -> Instruction
   86 pattern LoadDP a  = ILS (LoadD a)