@@ -2,12 +2,16 @@
22
33module Nock (tar, hax, fas, cell, atom, Annotation (..), Noun, RawNoun (..)) where
44
5−import Control.DeepSeq (NFData)
5+import Control.DeepSeq (force)
6+import Control.Parallel.Strategies
7+import Data.Bits
68import Data.Hashable
9+import Debug.Trace
10+import GHC.Conc (par)
711import GHC.Generics (Generic)
812import Numeric.Natural
913
10−data Annotation = Annotation
14+newtype Annotation = Annotation
1115 { hash :: Int
1216 }
1317 deriving stock (Show, Generic)
@@ -58,14 +62,18 @@ data RawNoun ann
5862
5963instance Eq (RawNoun ann) where
6064 (Atom lhs _) == (Atom rhs _) = lhs == rhs
61− (Cell lhslhs lhsrhs _) == (Cell rhslhs rhsrhs _) = lhslhs == rhslhs && lhsrhs == rhsrhs
65+ (Cell lhslhs lhsrhs _) == (Cell rhslhs rhsrhs _) =
66+ let rhsRes = lhsrhs == rhsrhs
67+ in (force rhsRes `par` lhslhs == rhslhs) && rhsRes
6268 _ == _ = False
6369
6470hashEq :: Noun -> Noun -> Bool
6571hashEq (Atom lhsNat lhsAnn) (Atom rhsNat rhsAnn) =
66− lhsAnn.hash == rhsAnn.hash && lhsNat == rhsNat
72+ let normalEq = lhsNat == rhsNat
73+ in (force normalEq `par` lhsAnn.hash == rhsAnn.hash) && normalEq
6774hashEq (Cell lhslhs lhsrhs lhsAnn) (Cell rhslhs rhsrhs rhsAnn) =
68− lhsAnn.hash == rhsAnn.hash && hashEq lhslhs rhslhs && hashEq lhsrhs rhsrhs
75+ let normalEq = hashEq lhslhs rhslhs && hashEq lhsrhs rhsrhs
76+ in (force normalEq `par` lhsAnn.hash == rhsAnn.hash) && normalEq
6977hashEq _ _ = False
7078
7179type Noun = RawNoun Annotation
@@ -88,21 +96,19 @@ fas lhs rhs =
8896 ~(Cell lhs' _ _) -> lhs'
8997 3 -> case rhs of
9098 ~(Cell _ rhs' _) -> rhs'
91− n
92− | n > 0 ->
93− let (d, m) = divMod n 2
94− in if m == 0
95− then fas 2 (fas d rhs)
96− else fas 3 (fas d rhs)
97− _ -> undefined
99+ n ->
100+ let rest = fas (unsafeShiftR n 1) rhs
101+ in if testBit n 0
102+ then fas 3 rest
103+ else fas 2 rest
98104
99105hax :: Natural -> Noun -> Noun -> Noun
100106hax n b c =
101− let (a, m) = divMod n 2
107+ let a = unsafeShiftR n 1
102108 in case n of
103109 1 -> b
104− _ | m == 0 -> hax a (cell b (fas (a + a + 1) c)) c
105− _ -> hax a (cell (fas (a + a) c) b) c
110+ _ | testBit n 0 -> hax a (cell (fas (n - 1) c) b) c
111+ _ -> hax a (cell b (fas (n + 1) c)) c
106112
107113tar :: Noun -> Noun
108114tar ~(Cell subject ~(Cell a b _) _) = tar' a b subject