content: {-# LANGUAGE OverloadedLists   #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE QuasiQuotes       #-}
  
  -- | Operations on boxed integers.
  --
  -- This module should be imported qualified to avoid clashes with standard
  -- Haskell definitions.
  module Stg.Prelude.Number (
      -- * Arithmetic
      add,
      sub,
      mul,
      div,
      mod,
  
      -- * Comparisons
      eq_Int,
      lt_Int,
      leq_Int,
      gt_Int,
      geq_Int,
      neq_Int,
  
      -- * Other
      min,
      max,
  ) where
  
  
  
  import Prelude ()
  
  import Data.Monoid ((<>))
  import Data.Text   (Text)
  
  import Stg.Language
  import Stg.Parser.QuasiQuoter
  
  -- $setup
  -- >>> :set -XOverloadedStrings
  -- >>> :set -XQuasiQuotes
  -- >>> :module +Stg.Language.Prettyprint
  
  
  
  binaryOp :: Text -> PrimOp -> Alts -> Program
  binaryOp name op primAlts =
      Program (Binds
          [(Var name, LambdaForm [] NoUpdate [Var "x", Var "y"]
              (Case (AppF (Var "x") []) (Alts (AlgebraicAlts
                  [AlgebraicAlt (Constr "Int#") [Var "x'"]
                      (Case (AppF (Var "y") []) (Alts (AlgebraicAlts
                          [AlgebraicAlt (Constr "Int#") [Var "y'"]
                              (Case (AppP op (AtomVar (Var "x'")) (AtomVar (Var "y'")))
                                  primAlts) ])
                          (DefaultBound (Var "err") (AppC (Constr ("Error_" <> name <> "_1")) [AtomVar (Var "err")])) ))])
                  (DefaultBound (Var "err") (AppC (Constr ("Error_" <> name <> "_2")) [AtomVar (Var "err")])) )))])
  
  
  
  primToBool :: Alts
  primToBool = [alts| 1# -> True; default -> False |]
  
  eq_Int, lt_Int, leq_Int, gt_Int, geq_Int, neq_Int :: Program
  
  -- | Equality of boxed integers
  eq_Int = binaryOp "eq_Int" Eq primToBool
  
  -- | Less-than for boxed integers
  lt_Int = binaryOp "lt_Int" Lt primToBool
  
  -- | Less-or-equal for boxed integers
  leq_Int = binaryOp "leq_Int" Leq primToBool
  
  -- | Greater-than for boxed integers
  gt_Int = binaryOp "gt_Int" Gt primToBool
  
  -- | Greater-or-equal for boxed integers
  geq_Int = binaryOp "geq_Int" Geq primToBool
  
  -- | Inequality of boxed integers
  neq_Int = binaryOp "neq_Int" Neq primToBool
  
  
  
  primIdInt :: Alts
  primIdInt = [alts| v -> Int# v |]
  
  add, sub, mul, div, mod :: Program
  
  -- | Binary addition of boxed integers
  add = binaryOp "add" Add primIdInt
  
  -- | Difference of boxed integers
  sub = binaryOp "sub" Sub primIdInt
  
  -- | Binary multiplication of boxed integers
  mul = binaryOp "mul" Mul primIdInt
  
  -- | Boxed integer division
  div = binaryOp "div" Div primIdInt
  
  -- | Boxed integer modulo operator
  mod = binaryOp "mod" Mod primIdInt
  
  -- | Minimum of two boxed integers
  min :: Program
  min = [program|
      min = \x y -> case x of
          Int# x' -> case y of
              Int# y' -> case <=# x' y' of
                  1#      -> x;
                  default -> y;
              badInt -> Error_min badInt;
          badInt -> Error_min badInt
      |]
  
  -- | Maximum of two boxed integers
  max :: Program
  max = [program|
      max = \x y -> case x of
          Int# x' -> case y of
              Int# y' -> case >=# x' y' of
                  1# -> x;
                  default -> y;
              badInt -> Error_min badInt;
          badInt -> Error_min badInt
      |]
  