never executed always true always false

    1 module HelVM.HelMA.Automaton.Instruction.Groups.SMInstruction where
    2 
    3 import           HelVM.HelMA.Automaton.Instruction.Extras.Common
    4 import           HelVM.HelMA.Automaton.Instruction.Extras.TextExtra
    5 import           HelVM.HelMA.Automaton.Instruction.Groups.IOInstruction
    6 
    7 import           HelVM.HelIO.Containers.Extra
    8 
    9 -- | Constructors
   10 
   11 blAnd :: OperatorType -> BinaryOperation
   12 blAnd Bitwise = BAnd
   13 blAnd Logical = LAnd
   14 
   15 blOr :: OperatorType -> BinaryOperation
   16 blOr Bitwise = BOr
   17 blOr Logical = LOr
   18 
   19 blXor :: OperatorType -> BinaryOperation
   20 blXor Bitwise = BXor
   21 blXor Logical = LXor
   22 
   23 blEQ :: OperatorType -> BinaryOperation
   24 blEQ Bitwise = BEQ
   25 blEQ Logical = LEQ
   26 
   27 blGT :: OperatorType -> BinaryOperation
   28 blGT Bitwise = BGT
   29 blGT Logical = LGT
   30 
   31 -- | Other functions
   32 
   33 calculateOps :: Integral a => a -> a -> [BinaryOperation] -> [a]
   34 calculateOps operand operand' = map (calculateOp operand operand')
   35 
   36 calculateOp :: Integral a => a -> a -> BinaryOperation -> a
   37 calculateOp operand operand' operation = doBinary operation operand' operand
   38 
   39 doBinary :: Integral a => BinaryOperation -> a -> a -> a
   40 doBinary Add = (+)
   41 doBinary Sub = (-)
   42 doBinary Mul = (*)
   43 doBinary Div = div
   44 doBinary Mod = mod
   45 doBinary o   = error $ show o
   46 
   47 -- | Types
   48 data SMInstruction =
   49     SPure    !SPureInstruction
   50   | SIO      !IOInstruction
   51   deriving stock (Eq , Read , Show)
   52 
   53 data SPureInstruction =
   54     Cons     !Integer
   55   | Unary    !UnaryOperation
   56   | Binary   !BinaryOperation
   57   | Binaries [BinaryOperation]
   58   | Indexed  !IndexOperand !IndexedOperation
   59   | Halibut
   60   | Pick
   61   | Discard
   62   deriving stock (Eq , Read , Show)
   63 
   64 data IndexOperand = ITop | IImmediate !Index
   65   deriving stock (Eq , Read , Show)
   66 
   67 data UnaryOperation = Neg | BNot | LNot | UImmediate Integer BinaryOperation
   68   deriving stock (Eq , Read , Show)
   69 
   70 data BinaryOperation =
   71      Add | Sub | Mul | Div | Mod
   72   | BAnd | BOr | BXor | BEQ | BGT
   73   | LAnd | LOr | LXor | LEQ | LGT
   74   deriving stock (Eq , Read , Show)
   75 
   76 data IndexedOperation = Copy | Move | Slide
   77   deriving stock (Eq , Read , Show)
   78 
   79 data OperatorType = Bitwise | Logical
   80 
   81 -- | Internal
   82 
   83 printSM :: SMInstruction -> Text
   84 printSM (SPure i) = printSPure i
   85 printSM (SIO   i) = printIO i <> "S"
   86 
   87 printSPure :: SPureInstruction -> Text
   88 printSPure (Unary    i  ) = printUnary i
   89 printSPure (Indexed  i o) = toLowerShow o <> printIndexOperand i
   90 printSPure (Binary   i  ) = toLowerShow i
   91 printSPure (Binaries i  ) = printBinaries i
   92 printSPure           i    = toLowerShow i
   93 
   94 printBinaries :: (Foldable c, Functor c, Show i) => c i -> Text
   95 printBinaries il = fmconcat $ toLowerShow <$> il
   96 
   97 printUnary :: UnaryOperation -> Text
   98 printUnary (UImmediate i o) = toLowerShow o <> "I " <> show i
   99 printUnary             i    = toLowerShow i
  100 
  101 printIndexOperand :: IndexOperand -> Text
  102 printIndexOperand ITop           = ""
  103 printIndexOperand (IImmediate i) = "I " <> show i