From cd92abaef0b01aadc3f105e6688902000341c1d3 Mon Sep 17 00:00:00 2001
From: sigma-andex <77549848+sigma-andex@users.noreply.github.com>
Date: Sat, 15 Oct 2022 20:44:24 +0100
Subject: [PATCH] Initial commit

---
 .gitignore                     |  10 ++
 package.json                   |  12 +++
 packages.dhall                 |   6 ++
 spago.dhall                    |   5 +
 src/Js/BigInt/BigInt.js        |  51 +++++++++
 src/Js/BigInt/BigInt.purs      | 126 ++++++++++++++++++++++
 test.dhall                     |  17 +++
 test/Js/BigInt/BigIntSpec.purs |  11 ++
 test/Main.purs                 | 185 +++++++++++++++++++++++++++++++++
 9 files changed, 423 insertions(+)
 create mode 100644 .gitignore
 create mode 100644 package.json
 create mode 100644 packages.dhall
 create mode 100644 spago.dhall
 create mode 100644 src/Js/BigInt/BigInt.js
 create mode 100644 src/Js/BigInt/BigInt.purs
 create mode 100644 test.dhall
 create mode 100644 test/Js/BigInt/BigIntSpec.purs
 create mode 100644 test/Main.purs

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..30efe19
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,10 @@
+/bower_components/
+/node_modules/
+/.pulp-cache/
+/output/
+/generated-docs/
+/.psc-package/
+/.psc*
+/.purs*
+/.psa*
+/.spago
diff --git a/package.json b/package.json
new file mode 100644
index 0000000..b70540b
--- /dev/null
+++ b/package.json
@@ -0,0 +1,12 @@
+{
+  "name": "purescript-js-bigints",
+  "version": "1.0.0",
+  "description": "",
+  "main": "index.js",
+  "scripts": {
+    "test": "echo \"Error: no test specified\" && exit 1"
+  },
+  "keywords": [],
+  "author": "",
+  "license": "ISC"
+}
diff --git a/packages.dhall b/packages.dhall
new file mode 100644
index 0000000..6d79d14
--- /dev/null
+++ b/packages.dhall
@@ -0,0 +1,6 @@
+
+let upstream =
+      https://github.com/purescript/package-sets/releases/download/psc-0.15.4-20221015/packages.dhall
+        sha256:4949f9f5c3626ad6a83ea6b8615999043361f50905f736bc4b7795cba6251927
+
+in  upstream
diff --git a/spago.dhall b/spago.dhall
new file mode 100644
index 0000000..d584760
--- /dev/null
+++ b/spago.dhall
@@ -0,0 +1,5 @@
+{ name = "js-bigints"
+, dependencies = [ "maybe", "prelude", "aff", "effect" ]
+, packages = ./packages.dhall
+, sources = [ "src/**/*.purs" ]
+}
diff --git a/src/Js/BigInt/BigInt.js b/src/Js/BigInt/BigInt.js
new file mode 100644
index 0000000..f543b0b
--- /dev/null
+++ b/src/Js/BigInt/BigInt.js
@@ -0,0 +1,51 @@
+export const fromStringImpl = (just) => (nothing) => (s) => {
+  try {
+    var x = BigInt(s);
+    return just(x);
+  } catch (err) {
+    return nothing;
+  }
+};
+
+export const fromInt = (n) => BigInt(n);
+
+export const fromTypeLevelInt = (str) => BigInt(str);
+
+export const biAdd = (x) => (y) => x + y;
+
+export const biMul = (x) => (y) => x * y;
+
+export const biSub = (x) => (y) => x - y;
+
+export const biMod = (x) => (y) => x % y;
+
+export const biZero = 0n;
+
+export const biOne = 1n;
+
+export const pow = (x) => (y) => y >= 0 ?  x ** y : 0;
+
+export const not = (x) => ~x;
+
+export const or = (x) => (y) => x | y;
+
+export const xor = (x) => (y) => x ^ y;
+
+export const and = (x) => (y) => x & y;
+
+export const shl = (x) => (n) => x << n;
+
+export const shr = (x) => (n) => x >> n;
+
+export const biEquals = (x) => (y) => x == y;
+
+export const biCompare = (x) => (y) => {
+  if (x === y) return 0;
+  else if (x > y) return 1;
+  else return -1;
+};
+
+export const toString = (x) => x.toString();
+
+export const asIntN = (bits) => (n) => BigInt.asIntN(bits, n);
+export const asUintN = (bits) => (n) => BigInt.asUintN(bits, n);
diff --git a/src/Js/BigInt/BigInt.purs b/src/Js/BigInt/BigInt.purs
new file mode 100644
index 0000000..e2f571e
--- /dev/null
+++ b/src/Js/BigInt/BigInt.purs
@@ -0,0 +1,126 @@
+module Js.BigInt.BigInt
+  ( BigInt
+  , and
+  , asIntN
+  , asUintN
+  , fromInt
+  , fromString
+  , fromTLInt
+  , not
+  , or
+  , pow
+  , shl
+  , shr
+  , toString
+  , xor
+  )
+  where
+
+import Prelude
+
+import Data.Maybe (Maybe(..))
+import Data.Reflectable (class Reflectable, reflectType)
+import Prim.Int (class ToString)
+import Type.Proxy (Proxy(..))
+
+foreign import data BigInt :: Type
+
+-- | FFI wrapper to parse a String into a BigInt.
+foreign import fromStringImpl
+  :: forall a
+   . (a -> Maybe a)
+  -> Maybe a
+  -> String
+  -> Maybe BigInt
+
+-- | Parse a string into a `BigInt`, assuming a decimal representation. Returns
+-- | `Nothing` if the parse fails.
+-- |
+-- | Examples:
+-- | ```purescript
+-- | fromString "42"
+-- | fromString "857981209301293808359384092830482"
+-- | fromString "1e100"
+-- | ```
+fromString ∷ String → Maybe BigInt
+fromString = fromStringImpl Just Nothing
+
+-- | Convert an integer to a BigInt.
+foreign import fromInt :: Int -> BigInt
+
+-- Note: this function should not be exported!
+-- It's only safe if used with type-level integers.
+foreign import fromTypeLevelInt :: String -> BigInt
+
+-- | Converts a type-level integer into a `BigInt`:
+-- | ```
+-- | import Type.Proxy (Proxy(..))
+-- | foo = fromTLInt (Proxy :: Proxy 857981209301293808359384092830482)
+-- | ```
+fromTLInt :: forall i sym. ToString i sym => Reflectable sym String => Proxy i -> BigInt
+fromTLInt _ = fromTypeLevelInt (reflectType (Proxy :: Proxy sym))
+
+foreign import biAdd :: BigInt -> BigInt -> BigInt
+foreign import biMul :: BigInt -> BigInt -> BigInt
+
+foreign import biZero :: BigInt
+
+foreign import biOne :: BigInt
+
+instance Semiring BigInt where
+  add = biAdd
+  zero = biZero
+  mul = biMul
+  one = biOne
+
+foreign import biSub :: BigInt -> BigInt -> BigInt
+
+instance Ring BigInt where
+  sub = biSub
+
+foreign import biMod :: BigInt -> BigInt -> BigInt
+
+instance CommutativeRing BigInt
+
+-- Raise an BigInt to the power of another BigInt.
+foreign import pow :: BigInt -> BigInt -> BigInt
+
+-- | or the bits.
+foreign import or :: BigInt -> BigInt -> BigInt
+
+-- | Invert the bits.
+foreign import not :: BigInt -> BigInt
+
+-- | Exlusive or the bits.
+foreign import xor :: BigInt -> BigInt -> BigInt
+
+-- | and the bits.
+foreign import and :: BigInt -> BigInt -> BigInt
+
+-- | shift the bits left and zero fill.
+foreign import shl :: BigInt -> BigInt -> BigInt
+
+-- | Shift the bits right and maintain pos/neg.
+foreign import shr :: BigInt -> BigInt -> BigInt
+
+foreign import biEquals :: BigInt -> BigInt -> Boolean
+
+instance Eq BigInt where
+  eq = biEquals
+
+foreign import biCompare :: BigInt -> BigInt -> Int
+
+instance Ord BigInt where
+  compare x y = case biCompare x y of
+    1 -> GT
+    0 -> EQ
+    _ -> LT
+
+-- | A decimal representation of the `BigInt` as a `String`.
+foreign import toString :: BigInt -> String
+
+-- | Clamps a BigInt value to the given number of bits, and returns that value as a signed integer.
+foreign import asIntN :: Int -> BigInt -> BigInt
+
+-- | Clamps a BigInt value to the given number of bits, and returns that value as an unsigned integer.
+foreign import asUintN :: Int -> BigInt -> BigInt
diff --git a/test.dhall b/test.dhall
new file mode 100644
index 0000000..fa954d0
--- /dev/null
+++ b/test.dhall
@@ -0,0 +1,17 @@
+let conf = ./spago.dhall
+
+in      conf
+    //  { sources = conf.sources # [ "test/**/*.purs" ]
+        , dependencies =
+              conf.dependencies
+            # [ "spec"
+              , "debug"
+              , "spec-discovery"
+              , "quickcheck"
+              , "assert"
+              , "quickcheck-laws"
+              , "arrays"
+              , "console"
+              , "foldable-traversable"
+              ]
+        }
diff --git a/test/Js/BigInt/BigIntSpec.purs b/test/Js/BigInt/BigIntSpec.purs
new file mode 100644
index 0000000..9da641b
--- /dev/null
+++ b/test/Js/BigInt/BigIntSpec.purs
@@ -0,0 +1,11 @@
+module Test.Js.BigInt.BigIntSpec
+  ( spec
+  )
+  where
+
+import Prelude
+
+import Test.Spec (Spec)
+
+spec :: Spec Unit
+spec = pure unit
diff --git a/test/Main.purs b/test/Main.purs
new file mode 100644
index 0000000..82e19a5
--- /dev/null
+++ b/test/Main.purs
@@ -0,0 +1,185 @@
+module Test.Main where
+
+import Data.Array.NonEmpty (cons')
+import Data.Foldable (fold)
+import Data.Maybe (Maybe(..), fromMaybe)
+import Debug (spy)
+import Effect (Effect)
+import Effect.Console (log)
+import Js.BigInt.BigInt (BigInt, and, fromInt, fromString, fromTLInt, not, or, pow, shl, shr, toString, xor)
+import Prelude (class CommutativeRing, class Eq, class Ord, class Ring, class Semiring, Unit, bind, compare, discard, identity, map, negate, one, pure, show, zero, ($), (*), (+), (-), (<$>), (<<<), (==))
+import Test.Assert (assert)
+import Test.QuickCheck (quickCheck)
+import Test.QuickCheck.Arbitrary (class Arbitrary)
+import Test.QuickCheck.Gen (Gen, arrayOf, chooseInt, elements, resize)
+import Test.QuickCheck.Laws.Data as Data
+import Type.Proxy (Proxy(..))
+
+-- | Newtype with an Arbitrary instance that generates only small integers
+newtype SmallInt = SmallInt Int
+
+instance Arbitrary SmallInt where
+  arbitrary = SmallInt <$> chooseInt (-5) 5
+
+runSmallInt :: SmallInt -> Int
+runSmallInt (SmallInt n) = n
+
+-- | Arbitrary instance for BigInt
+newtype TestBigInt = TestBigInt BigInt
+derive newtype instance Eq TestBigInt
+derive newtype instance Ord TestBigInt
+derive newtype instance Semiring TestBigInt
+derive newtype instance Ring TestBigInt
+derive newtype instance CommutativeRing TestBigInt
+
+instance Arbitrary TestBigInt where
+  arbitrary = do
+    n <- (fromMaybe zero <<< fromString) <$> digitString
+    op <- elements (cons' identity [negate])
+    pure (TestBigInt (op n))
+    where digits :: Gen Int
+          digits = chooseInt 0 9
+          digitString :: Gen String
+          digitString = (fold <<< map show) <$> (resize 50 $ arrayOf digits)
+
+-- | Convert SmallInt to BigInt
+fromSmallInt :: SmallInt -> BigInt
+fromSmallInt = fromInt <<< runSmallInt
+
+-- | Test if a binary relation holds before and after converting to BigInt.
+testBinary :: (BigInt -> BigInt -> BigInt)
+           -> (Int -> Int -> Int)
+           -> Effect Unit
+testBinary f g = quickCheck (\x y -> (fromInt x) `f` (fromInt y) == fromInt (x `g` y))
+
+main :: Effect Unit
+main = do
+  log "Simple arithmetic operations and conversions from Int"
+  let two = one + one
+  let three = two + one
+  let four = three + one
+  assert $ fromInt 3 == three
+  assert $ two * two == four
+  assert $ two * three * (three + four) == fromInt 42
+  assert $ two - three == fromInt (-1)
+
+  log "Parsing strings"
+  assert $ fromString "2" == Just two
+  assert $ fromString "a" == Nothing
+  assert $ fromString "2.1" == Nothing
+  assert $ fromString "123456789" == Just (fromInt 123456789)
+  assert $ fromString "10000000" == Just (fromInt 10000000)
+  quickCheck $ \(TestBigInt a) -> (fromString <<< toString) a == Just a
+
+  log "Parsing strings with a different base"
+  assert $ fromString "0b100" == Just four
+  assert $ fromString "0xff" == fromString "255"
+
+  log "Rendering bigints as strings with a different base"
+  -- assert $ toBase 2 four == "100"
+  -- assert $ (toBase 16 <$> fromString "255") == Just "ff"
+  assert $ toString (fromInt 12345) == "12345"
+
+  log "Converting bigints to arrays with a different base"
+  -- assert $ NEA.toArray (digitsInBase 2 four).value == [1, 0, 0]
+  -- assert $ (NEA.toArray <<< _.value <<< digitsInBase 16 <$>
+  --          fromString "255") == Just [15, 15]
+  -- assert $ NEA.toArray (digitsInBase 10 $ fromInt 12345).value
+  --          == [1, 2, 3, 4, 5]
+
+  -- assert $ toBase' 2 four == unsafePartial unsafeFromString "100"
+  -- assert $ (toBase' 16 <$> fromString "255") == NES.fromString "ff"
+  -- assert $ toNonEmptyString (fromInt 12345)
+  --          == unsafePartial unsafeFromString "12345"
+
+  -- log "Converting from Number to BigInt"
+  -- assert $ fromNumber 0.0 == Just zero
+  -- assert $ fromNumber 3.4 == Just three
+  -- assert $ fromNumber (-3.9) == Just (-three)
+  -- assert $ fromNumber 1.0e7 == Just (fromInt 10000000)
+  -- assert $ fromNumber 1.0e47 == fromString "100000000000000004384584304507619735463404765184"
+  -- quickCheck (\x -> Just (fromInt x) == fromNumber (Int.toNumber x))
+
+  log "Conversions between String, Int and BigInt should not loose precision"
+  quickCheck (\n -> fromString (show n) == Just (fromInt n))
+  -- quickCheck (\n -> Int.toNumber n == toNumber (fromInt n))
+
+  log "Binary relations between integers should hold before and after converting to BigInt"
+  testBinary (+) (+)
+  testBinary (-) (-)
+  -- testBinary mod mod
+  -- testBinary div div
+  -- testBinary quot Int.quot
+  -- testBinary rem Int.rem
+
+  -- To test the multiplication, we need to make sure that Int does not overflow
+  quickCheck (\x y -> fromSmallInt x * fromSmallInt y == fromInt (runSmallInt x * runSmallInt y))
+
+  log "It should perform multiplications which would lead to imprecise results using Number"
+  assert $ Just (fromInt 333190782 * fromInt 1103515245) == fromString "367681107430471590"
+
+  log "compare, (==), even, odd should be the same before and after converting to BigInt"
+  quickCheck (\x y -> compare x y == compare (fromInt x) (fromInt y))
+  quickCheck (\x y -> (fromSmallInt x == fromSmallInt y) == (runSmallInt x == runSmallInt y))
+  -- quickCheck (\x -> Int.even x == even (fromInt x))
+  -- quickCheck (\x -> Int.odd x == odd (fromInt x))
+
+  log "pow should perform integer exponentiation and yield 0 for negative exponents"
+  assert $ three `pow` four == fromInt 81
+  assert $ (spy "2" $  three `pow` -two) == (spy "zero" zero)
+  assert $ (spy "3" $ three `pow` zero) == one
+  assert $ zero `pow` zero == one
+
+  -- log "Prime numbers"
+  -- assert $ filter (prime <<< fromInt) (range 2 20) == [2, 3, 5, 7, 11, 13, 17, 19]
+
+  -- log "Absolute value"
+  -- quickCheck $ \(TestBigInt x) -> abs x == if x > zero then x else (-x)
+
+  log "Logic"
+  assert $ (not <<< not) one == one
+  assert $ or one three == three
+  assert $ xor one three == two
+  assert $ and one three == one
+
+  log "Shifting"
+  assert $ shl two one == four
+  assert $ shr two one == one
+
+  let prxBigInt = Proxy ∷ Proxy TestBigInt
+  Data.checkEq prxBigInt
+  Data.checkOrd prxBigInt
+  Data.checkSemiring prxBigInt
+  Data.checkRing prxBigInt
+  -- Data.checkEuclideanRing prxBigInt
+  Data.checkCommutativeRing prxBigInt
+
+  -- log "Infinity and NaN"
+  -- assert $ fromNumber infinity == Nothing
+  -- assert $ fromNumber (-infinity) == Nothing
+  -- assert $ fromNumber nan == Nothing
+
+  log "Converting BigInt to Int"
+  -- assert $ (fromString "0" <#> asIntN 64) == Just 0
+  -- assert $ (fromString "2137" <#> asIntN 64) == Just 2137
+  -- assert $ (fromString "-2137" <#> asIntN 64) == Just (-2137)
+  -- assert $ (fromString "2147483647" <#> asIntN 64) == Just 2147483647
+  -- assert $ (fromString "2147483648" <#> asIntN 64) == Nothing
+  -- assert $ (fromString "-2147483648" <#> asIntN 64) == Just (-2147483648)
+  -- assert $ (fromString "-2147483649" <#> asIntN 64) == Nothing
+  -- assert $ (fromString "921231231322337203685124775809" <#> asIntN 64) == Nothing
+  -- assert $ (fromString "-922337203612312312312854775809" <#> asIntN 64) == Nothing
+  -- quickCheck (\a b c ->
+  --              let x = add (fromInt a) (add (fromInt b) (fromInt c))
+  --              in case asIntN 64 x of
+  --                Nothing -> x < fromInt (-2147483648) || x > fromInt 2147483647
+  --                Just i -> fromInt i == x
+  --            )
+
+  log "Type Level Int creation"
+  assert $ toString (fromTLInt (Proxy :: Proxy 921231231322337203685124775809)) == "921231231322337203685124775809"
+  assert $ toString (fromTLInt (Proxy :: Proxy (-921231231322337203685124775809))) == "-921231231322337203685124775809"
+
+-- main :: Effect Unit
+-- main = launchAff_ $ runSpec [consoleReporter] do
+--   BigIntSpec.spec