Implement bitWidth (for cue/rub).

pkg/hair/lib/Data/Noun.hs

@@ -6,7 +6,7 @@ import Prelude
 
 import Control.Applicative
 import Control.Monad
-import Numeric.Natural
+import Data.Noun.Atom
 import Data.Bits
 
 import Data.List     (intercalate)
@@ -17,8 +17,6 @@ import qualified Control.Monad.Fail as Fail
 
 -- Types -----------------------------------------------------------------------
 
-type Atom = Natural
-
 data Cell = ACell !Noun !Noun
   deriving (Eq, Ord)
 

pkg/hair/lib/Data/Noun/Atom.hs

@@ -0,0 +1,27 @@
+{-# LANGUAGE MagicHash, GeneralizedNewtypeDeriving, UnboxedTuples #-}
+
+module Data.Noun.Atom where
+
+import ClassyPrelude
+import Prelude ((^))
+import GHC.Integer.GMP.Internals
+import GHC.Natural
+import GHC.Prim
+import GHC.Word
+
+newtype Atom = Atom Natural
+  deriving (Eq, Ord, Show, Num)
+
+wordBitWidth :: Word# -> Word#
+wordBitWidth w = minusWord# 64## (clz# w)
+
+bigNatBitWidth :: BigNat -> Word#
+bigNatBitWidth nat =
+    lswBits `plusWord#` ((int2Word# lastIdx) `timesWord#` 64##)
+  where
+    (# lastIdx, _ #) = subIntC# (sizeofBigNat# nat) 1#
+    lswBits          = wordBitWidth (indexBigNat# nat lastIdx)
+
+bitWidth :: Atom -> Atom
+bitWidth (Atom (NatS# gl)) = Atom (NatS# (wordBitWidth gl))
+bitWidth (Atom (NatJ# bn)) = Atom (NatS# (bigNatBitWidth bn))

pkg/hair/lib/Data/Noun/Jam.hs

@@ -2,6 +2,7 @@ module Data.Noun.Jam where
 
 import ClassyPrelude
 import Data.Noun
+import Data.Noun.Atom
 import Data.Noun.Poet
 import Data.Bits
 import Control.Lens
@@ -14,9 +15,6 @@ import Control.Monad (guard)
 jam :: Noun -> Atom
 jam = undefined
 
-bitWidth :: Atom -> Atom
-bitWidth = undefined
-
 bitIdx :: Atom -> Atom -> Bool
 bitIdx idx buf = testBit buf (fromIntegral idx)
 

pkg/hair/lib/Data/Noun/Poet.hs

@@ -4,7 +4,7 @@ import Prelude
 
 import Control.Applicative
 import Control.Monad
-import Numeric.Natural
+import GHC.Natural
 import Data.Noun
 
 import Data.Word     (Word, Word32, Word64)

pkg/hair/stack.yaml

@@ -3,5 +3,8 @@ resolver: lts-13.10
 packages:
   - .
 
+ghc-options:
+  vere: "-fobject-code"
+
 extra-deps:
   - para-1.1@sha256:a90eebb063ad70271e6e2a7f00a93e8e8f8b77273f100f39852fbf8301926f81