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 LGT = lGT
   46 doBinary o   = error $ show o
   47 
   48 lGT ∷ (Integral a1) ⇒ a1 → a1 → a1
   49 lGT a b = fromBool $ a > b
   50 
   51 fromBool ∷ Integral a ⇒ Bool → a
   52 fromBool False = 0
   53 fromBool True  = 1
   54 
   55 toBool ∷ Integral a ⇒ a → Bool
   56 toBool a = a /= 0
   57 
   58 -- | Types
   59 data SMInstruction
   60   = SPure !SPureInstruction
   61   | SIO !IOInstruction
   62   deriving stock (Eq, Read, Show)
   63 
   64 data SPureInstruction
   65   = Cons !Integer
   66   | Unary !UnaryOperation
   67   | Binary !BinaryOperation
   68   | Binaries [BinaryOperation]
   69   | Indexed !IndexOperand !IndexedOperation
   70   | Halibut
   71   | Pick
   72   | Discard
   73   deriving stock (Eq, Read, Show)
   74 
   75 data IndexOperand
   76   = ITop
   77   | IImmediate !ImmediateIndex
   78   deriving stock (Eq, Read, Show)
   79 
   80 data UnaryOperation
   81   = Neg
   82   | BNot
   83   | LNot
   84   | UImmediate Integer BinaryOperation
   85   deriving stock (Eq, Read, Show)
   86 
   87 data BinaryOperation
   88   = Add
   89   | Sub
   90   | Mul
   91   | Div
   92   | Mod
   93   | BAnd
   94   | BOr
   95   | BXor
   96   | BEQ
   97   | BGT
   98   | LAnd
   99   | LOr
  100   | LXor
  101   | LEQ
  102   | LGT
  103   deriving stock (Eq, Read, Show)
  104 
  105 data IndexedOperation
  106   = Copy
  107   | Move
  108   | Slide
  109   deriving stock (Eq, Read, Show)
  110 
  111 data OperatorType
  112   = Bitwise
  113   | Logical
  114 
  115 -- | Internal
  116 
  117 printSM ∷ SMInstruction → Text
  118 printSM (SPure i) = printSPure i
  119 printSM (SIO   i) = printIO i <> "S"
  120 
  121 printSPure ∷ SPureInstruction → Text
  122 printSPure (Unary    i  ) = printUnary i
  123 printSPure (Indexed  i o) = toLowerShow o <> printIndexOperand i
  124 printSPure (Binary   i  ) = toLowerShow i
  125 printSPure (Binaries i  ) = printBinaries i
  126 printSPure           i    = toLowerShow i
  127 
  128 printBinaries ∷ (Foldable c, Functor c, Show i) ⇒ c i → Text
  129 printBinaries il = fmconcat $ toLowerShow <$> il
  130 
  131 printUnary ∷ UnaryOperation → Text
  132 printUnary (UImmediate i o) = toLowerShow o <> "I " <> show i
  133 printUnary             i    = toLowerShow i
  134 
  135 printIndexOperand ∷ IndexOperand → Text
  136 printIndexOperand ITop           = ""
  137 printIndexOperand (IImmediate i) = "I " <> show i