diff --git a/bower.json b/bower.json index 67ca3eb..4c81a80 100644 --- a/bower.json +++ b/bower.json @@ -25,6 +25,9 @@ "purescript-strings": "^3.0.0" }, "devDependencies": { - "purescript-console": "^3.0.0" + "purescript-refs": "^3.0.0", + "purescript-console": "^3.0.0", + "purescript-assert": "^3.0.0", + "purescript-quickcheck": "^4.0.0" } } diff --git a/src/Data/Function/Memoize.purs b/src/Data/Function/Memoize.purs index 633f7eb..106212b 100644 --- a/src/Data/Function/Memoize.purs +++ b/src/Data/Function/Memoize.purs @@ -16,8 +16,8 @@ module Data.Function.Memoize import Prelude import Data.Char (fromCharCode, toCharCode) import Data.Either (Either(..)) -import Data.Generic.Rep (class Generic, Argument(..), Constructor(..), - NoArguments(..), Product(..), Sum(..), from, to) +import Data.Generic.Rep (class Generic, Argument(..), Constructor(..), NoArguments(..), Product(..), Sum(..), from, to) +import Data.Int.Bits ((.&.), zshr) import Data.Lazy (Lazy, force, defer) import Data.List (List(..), fromFoldable, toUnfoldable) import Data.Maybe (Maybe(..)) @@ -117,18 +117,10 @@ instance tabulateNat :: Tabulate Int where tabulateImpl f = go where go :: Int -> Lazy r - go 0 = zer - go n = walk (bits (if n > 0 then n else (-n))) - (if n > 0 then pos else neg) + go n = walk (bits n) trie - pos :: NatTrie r - pos = build 1 - - neg :: NatTrie r - neg = build (-1) - - zer :: Lazy r - zer = defer \_ -> f 0 + trie :: NatTrie r + trie = build 0 build :: Int -> NatTrie r build n = NatTrie (defer \_ -> f n) @@ -138,8 +130,8 @@ instance tabulateNat :: Tabulate Int where bits :: Int -> List Boolean bits = bits' Nil where - bits' acc 1 = acc - bits' acc n = bits' (Cons (mod n 2 /= 0) acc) (n / 2) + bits' acc 0 = acc + bits' acc n = bits' (Cons (n .&. 1 /= 0) acc) (n `zshr` 1) walk :: forall a. List Boolean -> NatTrie a -> Lazy a walk Nil (NatTrie a _ _) = a diff --git a/test/Main.purs b/test/Main.purs index 31d792e..9605448 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -1,12 +1,19 @@ module Test.Main where import Prelude +import Data.Generic.Rep as G import Control.Monad.Eff (Eff) import Control.Monad.Eff.Console (CONSOLE, logShow) +import Control.Monad.Eff.Exception (EXCEPTION) +import Control.Monad.Eff.Random (RANDOM) +import Control.Monad.Eff.Ref (REF, newRef, modifyRef, readRef) +import Control.Monad.Eff.Unsafe (unsafePerformEff) import Data.Function.Memoize (class Tabulate, memoize, memoize2, genericTabulate) -import Data.Generic.Rep (class Generic) import Data.List ((:), length, singleton) import Data.String (take, drop) +import Test.QuickCheck (quickCheck') +import Test.QuickCheck.Arbitrary (class Arbitrary, arbitrary) +import Test.Assert (ASSERT, assert') data Diff a = Add a | Remove a @@ -18,12 +25,18 @@ data Ints = Int1 Int | Int2 Int -derive instance genericInts :: Generic Ints _ +derive instance genericInts :: G.Generic Ints _ instance tabulateInts :: Tabulate Ints where tabulate = genericTabulate -main :: forall eff. Eff (console :: CONSOLE | eff) Unit + +newtype SmallInt = SmallInt Int + +instance arbSmallInt :: Arbitrary SmallInt where + arbitrary = SmallInt <<< (_ `mod` 1000) <$> arbitrary + +main :: forall eff. Eff (assert :: ASSERT, ref :: REF, console :: CONSOLE, random :: RANDOM, exception :: EXCEPTION | eff) Unit main = do let fibonacciFast = go 0 1 where @@ -62,3 +75,12 @@ main = do | otherwise -> smallest (Add (take 1 s2) : diff s1 (drop 1 s2)) (Remove (take 1 s1) : diff (drop 1 s1) s2) logShow $ diff "Hello, PureScript" "ello, PureScript!" + + called <- newRef 0 + let fn x = 2 * x + msin = memoize \n -> unsafePerformEff do + modifyRef called (_ + 1) + pure $ fn n + quickCheck' 10000 $ \(SmallInt x) -> fn x == msin x + ncalled <- readRef called + assert' "Memoized function called too many times" (ncalled < 2000)