@@ -8,6 +8,7 @@ import Effectful
88import Effectful.State.Static.Local qualified as SEL
99import GHC.Base
1010import GHC.Num
11+import GHC.Num.BigNat (bigNatAddWord#, bigNatFromWord2#)
1112import Nock.Types
1213
1314sig :: Noun
@@ -36,13 +37,17 @@ wut Cell {} = sig
3637wut Atom {} = one
3738
3839lus :: Noun -> Noun
39−lus ~(Atom nat _) = atom (nat + 1)
40+lus ~(Atom nat _) = atom $ case nat of
41+ (NS n) -> case addWordC# n 1## of
42+ (# l, 0# #) -> NS l
43+ (# l, c #) -> NB (bigNatFromWord2# (int2Word# c) l)
44+ (NB n) -> NB (bigNatAddWord# n 1##)
4045
4146tis :: (SEL.State EqualityCache :> es, IOE :> es) => Noun -> Noun -> Eff es Noun
4247tis lhs rhs = nounEq lhs rhs <&> \eq -> if eq then sig else one
4348
44−fasWord :: Word# -> Noun -> Noun
45−fasWord lhs rhs =
49+fas# :: Word# -> Noun -> Noun
50+fas# lhs rhs =
4651 case lhs of
4752 1## -> rhs
4853 2## -> case rhs of
@@ -50,35 +55,34 @@ fasWord lhs rhs =
5055 3## -> case rhs of
5156 ~(Cell _ rhs' _) -> rhs'
5257 n ->
53− let rest = fasWord (uncheckedShiftRL# n 1#) rhs
58+ let rest = fas# (uncheckedShiftRL# n 1#) rhs
5459 in case and# 1## n of
55− 1## -> fasWord 3## rest
56− _ -> fasWord 2## rest
60+ 1## -> fas# 3## rest
61+ _ -> fas# 2## rest
5762
5863fas :: Natural -> Noun -> Noun
59−fas (NS w) rhs = fasWord w rhs
64+fas (NS w) rhs = fas# w rhs
6065fas n rhs =
6166 let rest = fas (unsafeShiftR n 1) rhs
6267 in if testBit n 0
6368 then fas 3 rest
6469 else fas 2 rest
6570
66−haxWord :: Word# -> Noun -> Noun -> Noun
67−haxWord 1## newValue _ = newValue
68−haxWord place newValue ~(Cell lhs rhs _) =
69− let a = uncheckedShiftRL# place 1#
70− in case and# place 1## of
71− 1## -> cell (haxWord a newValue lhs) rhs
72− _ -> cell lhs (haxWord a newValue rhs)
71+hax# :: Word# -> Noun -> Noun -> Noun
72+hax# 1## b _ = b
73+hax# n b c =
74+ let a = uncheckedShiftRL# n 1#
75+ in case and# n 1## of
76+ 1## -> hax# a (cell (fas# (n `xor#` 1##) c) b) c
77+ _ -> hax# a (cell b (fas# (n `or#` 1##) c)) c
7378
7479hax :: Natural -> Noun -> Noun -> Noun
75−hax (NS n) b c = haxWord n b c
80+hax (NS n) b c = hax# n b c
7681hax n b c =
7782 let a = unsafeShiftR n 1
78− in case n of
79− 1 -> b
80− _ | testBit n 0 -> hax a (cell (fas (n - 1) c) b) c
81− _ -> hax a (cell b (fas (n + 1) c)) c
83+ in if testBit n 0
84+ then hax a (cell (fas (n - 1) c) b) c
85+ else hax a (cell b (fas (n + 1) c)) c
8286
8387tar :: (SEL.State EqualityCache :> es, IOE :> es) => Noun -> Eff es Noun
8488tar ~(Cell subject ~(Cell a b _) _) = tar' a b subject