{- ORMOLU_DISABLE -}
-- Implicit CAD. Copyright (C) 2011, Christopher Olah (chris@colah.ca)
-- Copyright 2014-2019, Julia Longtin (julial@turinglace.com)
-- Released under the GNU AGPLV3+, see LICENSE

-- Use existing instances for the wrapped types rather than manually manking them
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Graphics.Implicit.FastIntUtil (Fastℕ(Fastℕ), toFastℕ, fromFastℕ) where

import Prelude (Integral, Num, Eq, Ord, Enum, Real, Show, Read, Int, id)

class FastN n where
  fromFastℕ :: Fastℕ -> n
  toFastℕ :: n -> Fastℕ

instance FastN Int where
  fromFastℕ :: Fastℕ -> Int
fromFastℕ (Fastℕ Int
a) = Int
a
  {-# INLINABLE fromFastℕ #-}
  toFastℕ :: Int -> Fastℕ
toFastℕ = Int -> Fastℕ
Fastℕ
  {-# INLINABLE toFastℕ #-}

instance FastN Fastℕ where
  fromFastℕ :: Fastℕ -> Fastℕ
fromFastℕ = forall a. a -> a
id
  {-# INLINABLE fromFastℕ #-}
  toFastℕ :: Fastℕ -> Fastℕ
toFastℕ = forall a. a -> a
id
  {-# INLINABLE toFastℕ #-}

-- System integers, meant to go fast, and have no chance of wrapping 2^31.
newtype Fastℕ = Fastℕ Int
  deriving (Int -> Fastℕ -> ShowS
[Fastℕ] -> ShowS
Fastℕ -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Fastℕ] -> ShowS
$cshowList :: [Fastℕ] -> ShowS
show :: Fastℕ -> String
$cshow :: Fastℕ -> String
showsPrec :: Int -> Fastℕ -> ShowS
$cshowsPrec :: Int -> Fastℕ -> ShowS
Show, ReadPrec [Fastℕ]
ReadPrec Fastℕ
Int -> ReadS Fastℕ
ReadS [Fastℕ]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Fastℕ]
$creadListPrec :: ReadPrec [Fastℕ]
readPrec :: ReadPrec Fastℕ
$creadPrec :: ReadPrec Fastℕ
readList :: ReadS [Fastℕ]
$creadList :: ReadS [Fastℕ]
readsPrec :: Int -> ReadS Fastℕ
$creadsPrec :: Int -> ReadS Fastℕ
Read, Fastℕ -> Fastℕ -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Fastℕ -> Fastℕ -> Bool
$c/= :: Fastℕ -> Fastℕ -> Bool
== :: Fastℕ -> Fastℕ -> Bool
$c== :: Fastℕ -> Fastℕ -> Bool
Eq, Eq Fastℕ
Fastℕ -> Fastℕ -> Bool
Fastℕ -> Fastℕ -> Ordering
Fastℕ -> Fastℕ -> Fastℕ
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Fastℕ -> Fastℕ -> Fastℕ
$cmin :: Fastℕ -> Fastℕ -> Fastℕ
max :: Fastℕ -> Fastℕ -> Fastℕ
$cmax :: Fastℕ -> Fastℕ -> Fastℕ
>= :: Fastℕ -> Fastℕ -> Bool
$c>= :: Fastℕ -> Fastℕ -> Bool
> :: Fastℕ -> Fastℕ -> Bool
$c> :: Fastℕ -> Fastℕ -> Bool
<= :: Fastℕ -> Fastℕ -> Bool
$c<= :: Fastℕ -> Fastℕ -> Bool
< :: Fastℕ -> Fastℕ -> Bool
$c< :: Fastℕ -> Fastℕ -> Bool
compare :: Fastℕ -> Fastℕ -> Ordering
$ccompare :: Fastℕ -> Fastℕ -> Ordering
Ord, Integer -> Fastℕ
Fastℕ -> Fastℕ
Fastℕ -> Fastℕ -> Fastℕ
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Fastℕ
$cfromInteger :: Integer -> Fastℕ
signum :: Fastℕ -> Fastℕ
$csignum :: Fastℕ -> Fastℕ
abs :: Fastℕ -> Fastℕ
$cabs :: Fastℕ -> Fastℕ
negate :: Fastℕ -> Fastℕ
$cnegate :: Fastℕ -> Fastℕ
* :: Fastℕ -> Fastℕ -> Fastℕ
$c* :: Fastℕ -> Fastℕ -> Fastℕ
- :: Fastℕ -> Fastℕ -> Fastℕ
$c- :: Fastℕ -> Fastℕ -> Fastℕ
+ :: Fastℕ -> Fastℕ -> Fastℕ
$c+ :: Fastℕ -> Fastℕ -> Fastℕ
Num, Int -> Fastℕ
Fastℕ -> Int
Fastℕ -> [Fastℕ]
Fastℕ -> Fastℕ
Fastℕ -> Fastℕ -> [Fastℕ]
Fastℕ -> Fastℕ -> Fastℕ -> [Fastℕ]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Fastℕ -> Fastℕ -> Fastℕ -> [Fastℕ]
$cenumFromThenTo :: Fastℕ -> Fastℕ -> Fastℕ -> [Fastℕ]
enumFromTo :: Fastℕ -> Fastℕ -> [Fastℕ]
$cenumFromTo :: Fastℕ -> Fastℕ -> [Fastℕ]
enumFromThen :: Fastℕ -> Fastℕ -> [Fastℕ]
$cenumFromThen :: Fastℕ -> Fastℕ -> [Fastℕ]
enumFrom :: Fastℕ -> [Fastℕ]
$cenumFrom :: Fastℕ -> [Fastℕ]
fromEnum :: Fastℕ -> Int
$cfromEnum :: Fastℕ -> Int
toEnum :: Int -> Fastℕ
$ctoEnum :: Int -> Fastℕ
pred :: Fastℕ -> Fastℕ
$cpred :: Fastℕ -> Fastℕ
succ :: Fastℕ -> Fastℕ
$csucc :: Fastℕ -> Fastℕ
Enum, Enum Fastℕ
Real Fastℕ
Fastℕ -> Integer
Fastℕ -> Fastℕ -> (Fastℕ, Fastℕ)
Fastℕ -> Fastℕ -> Fastℕ
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Fastℕ -> Integer
$ctoInteger :: Fastℕ -> Integer
divMod :: Fastℕ -> Fastℕ -> (Fastℕ, Fastℕ)
$cdivMod :: Fastℕ -> Fastℕ -> (Fastℕ, Fastℕ)
quotRem :: Fastℕ -> Fastℕ -> (Fastℕ, Fastℕ)
$cquotRem :: Fastℕ -> Fastℕ -> (Fastℕ, Fastℕ)
mod :: Fastℕ -> Fastℕ -> Fastℕ
$cmod :: Fastℕ -> Fastℕ -> Fastℕ
div :: Fastℕ -> Fastℕ -> Fastℕ
$cdiv :: Fastℕ -> Fastℕ -> Fastℕ
rem :: Fastℕ -> Fastℕ -> Fastℕ
$crem :: Fastℕ -> Fastℕ -> Fastℕ
quot :: Fastℕ -> Fastℕ -> Fastℕ
$cquot :: Fastℕ -> Fastℕ -> Fastℕ
Integral, Num Fastℕ
Ord Fastℕ
Fastℕ -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Fastℕ -> Rational
$ctoRational :: Fastℕ -> Rational
Real)