diff --git a/lib/Urbit/Ob/Co.hs b/lib/Urbit/Ob/Co.hs --- a/lib/Urbit/Ob/Co.hs +++ b/lib/Urbit/Ob/Co.hs @@ -1,4 +1,3 @@ -{-# OPTIONS_GHC -Wall #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} @@ -11,8 +10,7 @@ ) where import qualified Data.ByteString as BS -import qualified Data.IntMap.Strict as IMS -import Data.Maybe (fromMaybe) +import qualified Data.Vector as V import qualified Data.Serialize as C import qualified Data.Text as T import Data.Word (Word8, Word16, Word) @@ -48,7 +46,8 @@ -- | Render a Patp value as Text. render :: Patp -> T.Text render (Patp p) = prefixed where - grab = fromMaybe (internalErr "render") + prefix = V.unsafeIndex prefixes . fromIntegral + suffix = V.unsafeIndex suffixes . fromIntegral prefixed = case T.uncons encoded of Just ('-', pp) -> T.cons '~' pp @@ -57,8 +56,8 @@ encoded = foldr alg mempty pruned where alg (idx, x) acc - | odd idx = grab (IMS.lookup (fromIntegral x) suffixes) <> acc - | otherwise = "-" <> grab (IMS.lookup (fromIntegral x) prefixes) <> acc + | odd idx = suffix x <> acc + | otherwise = "-" <> prefix x <> acc pruned = let len = BS.length p @@ -66,8 +65,8 @@ padding (idx, val) = idx /= 1 && val == 0 in dropWhile padding indexed -prefixes :: IMS.IntMap T.Text -prefixes = IMS.fromList $ zip [0..] +prefixes :: V.Vector T.Text +prefixes = V.fromList ["doz","mar","bin","wan","sam","lit","sig","hid","fid","lis","sog","dir" ,"wac","sab","wis","sib","rig","sol","dop","mod","fog","lid","hop","dar" ,"dor","lor","hod","fol","rin","tog","sil","mir","hol","pas","lac","rov" @@ -91,8 +90,8 @@ ,"lap","tal","pit","nam","bon","ros","ton","fod","pon","sov","noc","sor" ,"lav","mat","mip","fip"] -suffixes :: IMS.IntMap T.Text -suffixes = IMS.fromList $ zip [0..] +suffixes :: V.Vector T.Text +suffixes = V.fromList ["zod","nec","bud","wes","sev","per","sut","let","ful","pen","syt","dur" ,"wep","ser","wyl","sun","ryp","syx","dyr","nup","heb","peg","lup","dep" ,"dys","put","lug","hec","ryt","tyv","syd","nex","lun","mep","lut","sep" @@ -124,7 +123,7 @@ met :: Integral a => a -> a -> a met = loop 0 where - loop !acc a !b + loop !acc a b | b == 0 = acc | otherwise = loop (succ acc) a (rsh a 1 b) diff --git a/lib/Urbit/Ob/Muk.hs b/lib/Urbit/Ob/Muk.hs --- a/lib/Urbit/Ob/Muk.hs +++ b/lib/Urbit/Ob/Muk.hs @@ -1,4 +1,3 @@ -{-# OPTIONS_GHC -Wall #-} module Urbit.Ob.Muk ( muk diff --git a/lib/Urbit/Ob/Ob.hs b/lib/Urbit/Ob/Ob.hs --- a/lib/Urbit/Ob/Ob.hs +++ b/lib/Urbit/Ob/Ob.hs @@ -1,4 +1,4 @@ -{-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE BangPatterns #-} module Urbit.Ob.Ob ( fein @@ -20,7 +20,7 @@ -- | Conceal structure v3. fein :: (Integral a, Bits a) => a -> a fein = loop where - loop pyn = + loop !pyn = let lo = pyn .&. 0xFFFFFFFF hi = pyn .&. 0xFFFFFFFF00000000 p32 = fromIntegral pyn :: Word32 @@ -33,7 +33,7 @@ -- | Restore structure v3. fynd :: (Integral a, Bits a) => a -> a fynd = loop where - loop cry = + loop !cry = let lo = cry .&. 0xFFFFFFFF hi = cry .&. 0xFFFFFFFF00000000 c32 = fromIntegral cry :: Word32 @@ -74,14 +74,13 @@ -- | 'Fe' in B&R (2002). capFe - :: Integral a - => Int - -> a - -> a - -> a - -> (Int -> a -> a) - -> a - -> a + :: Int + -> Word32 + -> Word32 + -> Word32 + -> (Int -> Word32 -> Word32) + -> Word32 + -> Word32 capFe r a b k f m | c < k = c | otherwise = fe r a b f c @@ -90,40 +89,44 @@ -- | 'fe' in B&R (2002). fe - :: Integral a - => Int - -> a - -> a - -> (Int -> a -> a) - -> a - -> a + :: Int + -> Word32 + -> Word32 + -> (Int -> Word32 -> Word32) + -> Word32 + -> Word32 fe r a b f m = loop 1 capL capR where capL = m `mod` a capR = m `div` a - loop j ell arr + loop j !ell !arr | j > r = - if odd r + if odd r || arr == a then a * arr + ell - else if arr == a - then a * arr + ell - else a * ell + arr + else a * ell + arr | otherwise = - let eff = f (pred j) arr - tmp = if odd j - then (ell + eff) `mod` a - else (ell + eff) `mod` b + let eff = f (pred j) arr + -- NB (jtobin): + -- + -- note that the "extra" modulo operators here are not redundant as + -- the addition of ell and eff can (silently) overflow Word32. + -- modulo p does not distribute over addition, but it does + -- "distribute modulo p," so this ensures we stay sufficiently + -- small. + tmp = if odd j + then (ell `mod` a + eff `mod` a) `mod` a + else (ell `mod` b + eff `mod` b) `mod` b + in loop (succ j) arr tmp -- | 'Fen' in B&R (2002). capFen - :: Integral a - => Int - -> a - -> a - -> a - -> (Int -> a -> a) - -> a - -> a + :: Int + -> Word32 + -> Word32 + -> Word32 + -> (Int -> Word32 -> Word32) + -> Word32 + -> Word32 capFen r a b k f m | c <= k = c | otherwise = fen r a b f c @@ -132,13 +135,12 @@ -- | 'fen' in B&R (2002). fen - :: Integral a - => Int - -> a - -> a - -> (Int -> a -> a) - -> a - -> a + :: Int + -> Word32 + -> Word32 + -> (Int -> Word32 -> Word32) + -> Word32 + -> Word32 fen r a b f m = loop r capL capR where ahh = if odd r @@ -160,7 +162,7 @@ then ale else ahh - loop j ell arr + loop j !ell !arr | j < 1 = a * arr + ell | otherwise = let eff = f (pred j) ell diff --git a/test/Co.hs b/test/Co.hs new file mode 100644 --- /dev/null +++ b/test/Co.hs @@ -0,0 +1,14 @@ +module Main where + +import Test.Hspec +import Test.Hspec.Core.QuickCheck (modifyMaxSuccess) +import Test.QuickCheck +import qualified Urbit.Ob.Co as Co + +main :: IO () +main = hspec $ + describe "fromPatp" $ + modifyMaxSuccess (const 1000) $ + it "inverts patp" $ + property $ \(NonNegative x) -> Co.fromPatp (Co.patp x) == x + diff --git a/test/Ob.hs b/test/Ob.hs new file mode 100644 --- /dev/null +++ b/test/Ob.hs @@ -0,0 +1,15 @@ +module Main where + +import qualified Ob.Tests.Small as S +import qualified Ob.Tests.Med as M +import qualified Ob.Tests.Property as P +import qualified Ob.Tests.Unit as U +import Test.Hspec + +main :: IO () +main = + hspec $ do + context "small input space" S.tests + context "medium input space" M.tests + context "32-bit input space" P.tests + context "unit tests" U.tests diff --git a/test/Ob/Tests/Med.hs b/test/Ob/Tests/Med.hs new file mode 100644 --- /dev/null +++ b/test/Ob/Tests/Med.hs @@ -0,0 +1,72 @@ +module Ob.Tests.Med ( + tests + ) where + +import Control.Monad (unless) +import Data.List (nub, foldl') +import Prelude hiding (tail) +import Test.Hspec +import qualified Urbit.Ob.Ob as Ob + +a = 2 ^ 4 - 1 +b = 2 ^ 4 +c = a * b + +emm = [ + 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, + 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, + 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, + 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, + 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, + 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, + 96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, + 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, 123, 124, 125, 126, 127, + 128, 129, 130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143, + 144, 145, 146, 147, 148, 149, 150, 151, 152, 153, 154, 155, 156, 157, 158, 159, + 160, 161, 162, 163, 164, 165, 166, 167, 168, 169, 170, 171, 172, 173, 174, 175, + 176, 177, 178, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, 191, + 192, 193, 194, 195, 196, 197, 198, 199, 200, 201, 202, 203, 204, 205, 206, 207, + 208, 209, 210, 211, 212, 213, 214, 215, 216, 217, 218, 219, 220, 221, 222, 223, + 224, 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238, 239 + ] + + +eff _ m = v0 !! fromIntegral m where + v0 = [ + 106, 54, 57, 110, 216, 157, 90, 138, 148, 205, 214, 229, 25, 104, 217, 70, 16, 91, + 180, 108, 189, 176, 67, 213, 154, 194, 122, 199, 136, 140, 36, 56, 87, 112, 8, 34, + 14, 171, 227, 160, 211, 228, 37, 121, 119, 65, 132, 45, 224, 61, 141, 59, 82, 77, + 74, 20, 130, 181, 123, 186, 166, 42, 81, 172, 105, 196, 44, 135, 156, 192, 116, 39, + 7, 40, 84, 169, 193, 131, 88, 142, 24, 128, 38, 222, 197, 218, 159, 30, 145, 58, + 53, 85, 62, 49, 158, 86, 72, 210, 225, 52, 73, 149, 143, 195, 124, 179, 219, 9, + 200, 64, 51, 48, 26, 234, 27, 232, 231, 153, 190, 133, 109, 126, 6, 178, 183, 151, + 117, 46, 161, 43, 185, 236, 127, 89, 223, 23, 69, 68, 209, 139, 19, 33, 79, 164, + 207, 50, 144, 31, 134, 170, 29, 107, 220, 184, 47, 103, 206, 201, 175, 125, 35, 114, + 146, 10, 55, 152, 98, 1, 168, 215, 28, 237, 101, 17, 155, 118, 83, 147, 115, 100, + 233, 4, 66, 0, 150, 203, 22, 5, 174, 11, 18, 177, 3, 165, 99, 167, 202, 212, + 163, 182, 80, 162, 71, 97, 12, 60, 113, 221, 204, 41, 226, 187, 63, 230, 2, 188, + 208, 76, 191, 235, 93, 13, 111, 238, 78, 198, 21, 92, 95, 94, 96, 102, 120, 239, + 32, 129, 15, 173, 137, 75 + ] + +feis = Ob.capFe 4 a b c eff + +tail = Ob.capFen 4 a b c eff + +tests :: Spec +tests = do + let perm = fmap feis emm + inv = fmap tail perm + distincts = nub perm + + describe "feis" $ do + it "produces distinct elements" $ + length distincts `shouldBe` length perm + + it "permutes successfully" $ + foldl' (\acc x -> x `elem` emm && acc) True perm `shouldBe` True + + describe "tail" $ + it "inverts feis" $ + emm `shouldBe` inv + diff --git a/test/Ob/Tests/Property.hs b/test/Ob/Tests/Property.hs new file mode 100644 --- /dev/null +++ b/test/Ob/Tests/Property.hs @@ -0,0 +1,22 @@ + +module Ob.Tests.Property ( + tests + ) where + +import Test.Hspec +import Test.Hspec.Core.QuickCheck (modifyMaxSuccess) +import Test.QuickCheck +import qualified Urbit.Ob.Ob as Ob + +tests :: Spec +tests = do + describe "feis" $ + modifyMaxSuccess (const 1000) $ + it "inverts tail" $ + property $ \x -> Ob.feis (Ob.tail x) == x + + describe "tail" $ + modifyMaxSuccess (const 1000) $ + it "inverts feis" $ + property $ \x -> Ob.tail (Ob.feis x) == x + diff --git a/test/Ob/Tests/Small.hs b/test/Ob/Tests/Small.hs new file mode 100644 --- /dev/null +++ b/test/Ob/Tests/Small.hs @@ -0,0 +1,53 @@ +module Ob.Tests.Small ( + tests + ) where + +import Control.Monad (unless) +import Data.List (nub, foldl') +import Prelude hiding (tail) +import Test.Hspec +import qualified Urbit.Ob.Ob as Ob + +a = 2 ^ 2 - 1 +b = 2 ^ 2 +c = a * b + +eff j m = + let v0 = [5, 9, 2, 6, 4, 0, 8, 7, 1, 10, 3, 11] + v1 = [2, 1, 0, 3, 10, 4, 9, 5, 7, 11, 6, 8] + v2 = [10, 6, 7, 1, 0, 11, 3, 9, 5, 2, 8, 4] + v3 = [11, 0, 3, 5, 9, 8, 6, 10, 4, 1, 2, 7] + + in case j of + 0 -> v0 !! fromIntegral m + 1 -> v1 !! fromIntegral m + 2 -> v2 !! fromIntegral m + _ -> v3 !! fromIntegral m + +feis = Ob.capFe 4 a b c eff + +tail = Ob.capFen 4 a b c eff + +tests :: Spec +tests = do + let emm = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11] + perm = fmap feis emm + inv = fmap tail perm + rinv = fmap feis inv + distincts = nub perm + + describe "feis" $ do + it "produces distinct elements" $ + length distincts `shouldBe` length perm + + it "permutes successfully" $ + foldl' (\acc x -> x `elem` emm && acc) True perm `shouldBe` True + + describe "feis" $ + it "inverts tail" $ + rinv `shouldBe` perm + + describe "tail" $ + it "inverts feis" $ + emm `shouldBe` inv + diff --git a/test/Ob/Tests/Unit.hs b/test/Ob/Tests/Unit.hs new file mode 100644 --- /dev/null +++ b/test/Ob/Tests/Unit.hs @@ -0,0 +1,15 @@ + +module Ob.Tests.Unit ( + tests + ) where + +import Test.Hspec +import qualified Urbit.Ob.Ob as Ob + +tests :: Spec +tests = + describe "tail . feis" $ + context "when applied to 2052065766" $ + it "should be the identity function" $ + Ob.tail (Ob.feis 2052065766) `shouldBe` 2052065766 + diff --git a/test/Small.hs b/test/Small.hs deleted file mode 100644 --- a/test/Small.hs +++ /dev/null @@ -1,47 +0,0 @@ -module Main where - -import Control.Monad (unless) -import Data.List (nub, foldl') -import Prelude hiding (tail) -import System.Exit (exitSuccess, exitFailure) -import qualified Urbit.Ob.Ob as Ob - -a, b, c :: Int -a = 2 ^ 2 - 1 -b = 2 ^ 2 -c = a * b - -eff j m = - let v0 = [5, 9, 2, 6, 4, 0, 8, 7, 1, 10, 3, 11] - v1 = [2, 1, 0, 3, 10, 4, 9, 5, 7, 11, 6, 8] - v2 = [10, 6, 7, 1, 0, 11, 3, 9, 5, 2, 8, 4] - v3 = [11, 0, 3, 5, 9, 8, 6, 10, 4, 1, 2, 7] - - in case j of - 0 -> v0 !! m - 1 -> v1 !! m - 2 -> v2 !! m - _ -> v3 !! m - -feis = Ob.capFe 4 a b c eff - -tail = Ob.capFen 4 a b c eff - -main :: IO () -main = do - let emm = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11] - perm = fmap feis emm - inv = fmap tail perm - distincts = nub perm - - let distinctElems = length distincts == length perm - unless distinctElems exitFailure - - let permuteSuccessful = foldl' (\acc x -> x `elem` emm && acc) True perm - unless permuteSuccessful exitFailure - - let tailInvertsFeis = emm == inv - unless tailInvertsFeis exitFailure - - exitSuccess - diff --git a/urbit-hob.cabal b/urbit-hob.cabal --- a/urbit-hob.cabal +++ b/urbit-hob.cabal @@ -1,7 +1,7 @@ name: urbit-hob -version: 0.1.0 +version: 0.1.1 synopsis: Hoon-style atom manipulation and printing functions -homepage: https://github.com/urbit/urbit-hob#readme +homepage: https://github.com/urbit/urbit-hob bug-reports: https://github.com/urbit/urbit-hob/issues author: Jared Tobin maintainer: jared@jtobin.io @@ -12,26 +12,24 @@ build-type: Simple cabal-version: >= 1.10 description: - Here you can primarily find functions for dealing with the "patp" phonetic - base used by Urbit. The '@p' encoding is used for naming ships; it uniquely + Here you can primarily find functions for dealing with the \"patp\" phonetic + base used by Urbit. The \@p encoding is used for naming ships; it uniquely represents a 32-bit number in a memorable and pronounceable fashion. . - The '@p' encoding is an obfuscated representation of an underlying 32-bit - number, in particular, hence the 'ob' in the library's name. + The \@p encoding is an obfuscated representation of an underlying 32-bit + number, in particular, hence the \"ob\" in the library's name. . - The library exposes two functions, 'patp' and 'fromPatp', for converting - between representations. You can render a 'Patp' value via the 'render' - function. + The @Urbit.Ob@ module exposes two functions, 'patp' and 'fromPatp', for + converting between representations. You can render a 'Patp' value via the + 'render' function. . Here's a quick example: . > import qualified Urbit.Ob as Ob > > let nidsut = Ob.patp 15663360 - > Ob.render nidsut - "~nidsut-tomdun" - > Ob.fromPatp nidsut - 15663360 + > Ob.render nidsut -- "~nidsut-tomdun" + > Ob.fromPatp nidsut -- 15663360 source-repository head type: git @@ -60,18 +58,40 @@ base >= 4.7 && < 6 , bytestring >= 0.10 && < 1 , cereal >= 0.5 && < 1 - , containers >= 0.5 && < 1 , murmur3 >= 1.0 && < 2 , text >= 1.2 && < 2 + , vector >= 0.12 && < 1 -Test-suite small +Test-suite ob type: exitcode-stdio-1.0 hs-source-dirs: test - main-is: Small.hs + main-is: Ob.hs + other-modules: + Ob.Tests.Small + Ob.Tests.Med + Ob.Tests.Property + Ob.Tests.Unit default-language: Haskell2010 ghc-options: -rtsopts build-depends: base + , hspec + , hspec-core + , QuickCheck + , urbit-hob + +Test-suite co + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Co.hs + default-language: Haskell2010 + ghc-options: + -rtsopts + build-depends: + base + , hspec + , hspec-core + , QuickCheck , urbit-hob