master..0ea69da · nock-hs

bench/Main.hs+1−2

since splitsnapshots

unifiedsplit

@@ -10,7 +10,6 @@ import Nock.Parser (noun)

10import System.FilePath.Posix

11import System.Process.Typed

12import Test.Tasty.Golden (findByExtension)

13−import Effectful

14

13

15main :: IO ()

14main :: IO ()

16main = do

15main = do

@@ -23,5 +22,5 @@ main = do

23 $ proc "urbit" ["eval"]

22 $ proc "urbit" ["eval"]

24 & setStdin (byteStringInput hoon)

23 & setStdin (byteStringInput hoon)

25 & setStderr nullStream

24 & setStderr nullStream

26− pure $ bench (takeBaseName hoonFile) $ nf (runPureEff . tar) $ cell (atom 0) nock

25+ pure $ bench (takeBaseName hoonFile) $ nf tar $ cell (atom 0) nock

27 defaultMain benchmarks

26 defaultMain benchmarks

flake.lockdeleted−59

@@ -1,59 +0,0 @@

1−{

2− "nodes": {

3− "flake-utils": {

4− "inputs": {

5− "systems": "systems"

6− },

7− "locked": {

8− "lastModified": 1731533236,

9− "narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=",

10− "owner": "numtide",

11− "repo": "flake-utils",

12− "rev": "11707dc2f618dd54ca8739b309ec4fc024de578b",

13− "type": "github"

14− },

15− "original": {

16− "id": "flake-utils",

17− "type": "indirect"

18− }

19− },

20− "nixpkgs": {

21− "locked": {

22− "lastModified": 1746141548,

23− "narHash": "sha256-IgBWhX7A2oJmZFIrpRuMnw5RAufVnfvOgHWgIdds+hc=",

24− "owner": "NixOS",

25− "repo": "nixpkgs",

26− "rev": "f02fddb8acef29a8b32f10a335d44828d7825b78",

27− "type": "github"

28− },

29− "original": {

30− "id": "nixpkgs",

31− "ref": "nixos-unstable",

32− "type": "indirect"

33− }

34− },

35− "root": {

36− "inputs": {

37− "flake-utils": "flake-utils",

38− "nixpkgs": "nixpkgs"

39− }

40− },

41− "systems": {

42− "locked": {

43− "lastModified": 1681028828,

44− "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",

45− "owner": "nix-systems",

46− "repo": "default",

47− "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",

48− "type": "github"

49− },

50− "original": {

51− "owner": "nix-systems",

52− "repo": "default",

53− "type": "github"

54− }

55− }

56− },

57− "root": "root",

58− "version": 7

59−}

flake.nixdeleted−24

@@ -1,24 +0,0 @@

1−{

2− inputs = {

3− nixpkgs.url = "nixpkgs/nixos-unstable";

4− flake-utils.url = "flake-utils";

5− };

6−

7− outputs = { self, flake-utils, nixpkgs }:

8− let

9− supportedSystems =

10− [ "x86_64-linux" "x86_64-darwin" "aarch64-darwin" "aarch64-linux" ];

11− compilerVersion = "984";

12− in flake-utils.lib.eachSystem supportedSystems (system:

13− let pkgs = import nixpkgs { inherit system; };

14− in {

15− devShells.default = pkgs.mkShell {

16− buildInputs = with pkgs; [

17− haskell.compiler."ghc${compilerVersion}"

18− (pkgs.haskell-language-server.override {

19− supportedGhcVersions = [ compilerVersion ];

20− })

21− ];

22− };

23− });

24−}

package.yaml−13

@@ -18,11 +18,6 @@ dependencies:

18 - gauge

19 - filepath

20 - deepseq

21− - effectful

22− - unordered-containers

23− - murmur3

24− - file-embed

25− - mtl

26library:

21library:

27 source-dirs: src

22 source-dirs: src

28

23

@@ -36,7 +31,6 @@ benchmarks:

36 main: bench/Main.hs

31 main: bench/Main.hs

37

32

38 dependencies:

33 dependencies:

39− - effectful

40 - tasty

34 - tasty

41 - nock

35 - nock

42ghc-options: >

36ghc-options: >

@@ -50,8 +44,6 @@ ghc-options: >

50 -Wno-missed-specialisations

44 -Wno-missed-specialisations

51 -Wno-partial-type-signatures

45 -Wno-partial-type-signatures

52 -threaded

46 -threaded

53− -with-rtsopts=-N

54− -O2

55

47

56language: GHC2021

48language: GHC2021

57

49

@@ -79,8 +71,6 @@ default-extensions:

79- NoFieldSelectors

71- NoFieldSelectors

80- AllowAmbiguousTypes

72- AllowAmbiguousTypes

81- ImpredicativeTypes

73- ImpredicativeTypes

82−- MagicHash

83−- UnboxedTuples

84

74

85tests:

75tests:

86 spec:

76 spec:

@@ -92,6 +82,3 @@ tests:

92 - nock

82 - nock

93 - tasty-hspec

83 - tasty-hspec

94 - hspec

84 - hspec

95− - effectful

96− - tasty-quickcheck

97− - tasty-hunit

res/dec.jamdeleted−11

@@ -1,11 +0,0 @@

1−�~[Y��lea��K��qpr�r�qpy�r�v�rpwpz�6x=�;89x9�<�98;�;�� r��!�.�b�46T�A�8��-a>̡bl��d� Z�C�:��0׳

2−� Xsql��`q؅�P)&�o��d� ZP>$� �A2d-��D;$��1H��]�� 9��0ׇlf�,l��:v��~A�x��.܆J1!\B:H��],H6��Cq�D;a|�`�9��b��5�t�FF��CV��;sq؅�p�� b��d �r8ɐA�� R��!�Y�I7xlt��L<�`��f��,n�~C��889x:�=x:89x9h\<� �^.�v��C�]� ��p�n��`C��.$��1H��p�Ϊ��q(�d� ZP>$�?��<Ի�\b��5�t�Gf'��C~A��\vA� |9��!Yq��f�pҍ^[~81X��2�8��`A20*�C�B9\0�lf '�8��ه3��_l��'�lf '�8��3��avC�bC�=T��],�p*��P)�]؅]� �␈9��,�d� Z/$n� � 2��P�� ذ�3H��~�`18dk��9��![s(��lf '�8�ѡ�3��a��C

3−�fr��f�pҍ�z81X��;sq� ��Ú�!�Y�I7xgt��L<�`�_l�3�ݐ�8$+1��N�q�kKsg�!�/6��7lL��ͬ��7�p&b0��`Ý��56�?��A�8>^.N.>��0ׇ�!-��j$C��n8��x�D{H�.�C1��N�q��g�!+6T��A��=T��P$�[��A��A2P�18�� ;փd� Z�áu�`��m8�̡bb��`��J�86T��

4−�!V�7��V��J�\��%��]+6��9� X��A2d-�� X��!�ha'�>\0�` �>H��p�V�18�`��A��R,��ݰ3��n�J7T�C��a�w� ��~��!� ��` �6��pwq��` �ɐA��a��CV��

5−� X��_�C�pN*Ƅ��A��`�7��-�szlXV:��V�18�`lX�_*�� X� ;�+6T��9=~á8$w��P<l��~�7+�b� ذB�8�0]� U�i~Xa?��A�a�q��Rz,��]� ��p��j=� ��P?mkv�6\��Jqh�16��a��C*�� X؅ݰ3}X3�P1��~��

6−� +��` ��b��V�18�`A��R,��pg� ��a��

7−�!�`C�X��P<��

8−�!� +�`C�X��P\~áu��C+�b��`�

9−�� P)��nؙ^C��o8��d��:��M�C��A��ɡ��a��C��A�a��~��`�

10−�� XC��ڹ6�cq��{� X� ��a��~��!�`�

11−�� P)��nؙ��e��~��~��!� �P)�]��ȡblh�:��-FcC��av�6�C��P)�aC��>��|��d� Z�A� 8W�� 2�vá5��C��s��!�Y�I7xca��L<�`��a7\��ǰ҂�ǰ�� W��],H��P$C��n��]x̰��k��]�C��l�D;$��á8H��]� ;��`A2�á8H��ݐ�9t�=\0�oع�8�!�ha~�� 2��`C�C7�C]x��9�`3k8��<�� P)�]� �Z7T�C[� �v� �_7ԏ�l�D;64�$C��.��A��1��v.��.΃d� Z؅߰sy�d{��{�`�!�Y�I7xma��L<�`��e�

src/Data/HashMap/Monadic.hsdeleted−155

@@ -1,155 +0,0 @@

1−module Data.HashMap.Monadic (MEq (..), insert, lookup) where

2−

3−import Control.Monad.ST (runST)

4−import Data.Bits

5−import Data.Functor ((<&>))

6−import Data.HashMap.Internal

7− ( Hash,

8− HashMap (..),

9− Leaf (..),

10− bitmapIndexedOrFull,

11− collision,

12− hash,

13− index,

14− mask,

15− nextShift,

16− ptrEq,

17− sparseIndex,

18− two,

19− update32,

20− )

21−import Data.HashMap.Internal.Array qualified as A

22−import Data.Hashable

23−import Prelude hiding (lookup)

24−

25−class MEq x m where

26− (===) :: x -> x -> m Bool

27−

28−insert :: (MEq k m, Hashable k, Monad m) => k -> v -> HashMap k v -> m (HashMap k v)

29−insert k v m = insert' (Data.HashMap.Internal.hash k) k v m

30−

31−insert' :: forall m k v. (MEq k m, Monad m) => Hash -> k -> v -> HashMap k v -> m (HashMap k v)

32−insert' h0 k0 v0 m0 = go h0 k0 v0 0 m0

33− where

34− -- go :: _ -> _ -> _ -> _ -> _ -> m _

35− go !h !k x !_ Empty = pure @m $ Leaf h (L k x)

36− go h k x s t@(Leaf hy l@(L ky y))

37− | hy == h = do

38− ky === k >>= \eq ->

39− if eq

40− then

41− if x `ptrEq` y

42− then pure @m t

43− else pure @m $ Leaf h (L k x)

44− else pure $ collision h l (L k x)

45− | otherwise = pure $ runST (two s h k x hy t)

46− go h k x s t@(BitmapIndexed b ary)

47− | b .&. m == 0 =

48− let !ary' = A.insert ary i $! Leaf h (L k x)

49− in pure $ bitmapIndexedOrFull (b .|. m) ary'

50− | otherwise = do

51− let !st = A.index ary i

52− !st' <- go h k x (nextShift s) st

53− if st' `ptrEq` st

54− then pure t

55− else pure $ BitmapIndexed b (A.update ary i st')

56− where

57− m = mask h s

58− i = sparseIndex b m

59− go h k x s t@(Full ary) = do

60− let !st = A.index ary i

61− !st' <- go h k x (nextShift s) st

62− if st' `ptrEq` st

63− then pure t

64− else pure $ Full (update32 ary i st')

65− where

66− i = index h s

67− go h k x s t@(Collision hy v)

68− | h == hy = Collision h <$> (updateOrSnocWith (\a _ -> (# a #)) k x v)

69− | otherwise = go h k x s $ BitmapIndexed (mask hy s) (A.singleton t)

70−

71−updateOrSnocWith ::

72− (MEq k m, Monad m) =>

73− (v -> v -> (# v #)) ->

74− k ->

75− v ->

76− A.Array (Leaf k v) ->

77− m (A.Array (Leaf k v))

78−updateOrSnocWith f = updateOrSnocWithKey (const f)

79−{-# INLINEABLE updateOrSnocWith #-}

80−

81−updateOrSnocWithKey ::

82− (MEq k m, Monad m) =>

83− (k -> v -> v -> (# v #)) ->

84− k ->

85− v ->

86− A.Array (Leaf k v) ->

87− m (A.Array (Leaf k v))

88−updateOrSnocWithKey f k0 v0 ary0 = go k0 v0 ary0 0 (A.length ary0)

89− where

90− go !k v !ary !i !n

91− -- Not found, append to the end.

92− | i >= n = pure $ A.snoc ary $ L k v

93− | otherwise =

94− let L kx y = A.index ary i

95− (# v2 #) = f k v y

96− in k === kx >>= \eq ->

97− if eq

98− then pure $ A.update ary i (L k v2)

99− else go k v ary (i + 1) n

100−

101−lookup :: (MEq k m, Hashable k, Monad m) => k -> HashMap k v -> m (Maybe v)

102−lookup k m = lookupCont Nothing (\v _i -> Just v) (Data.HashMap.Internal.hash k) k 0 m

103−

104−lookupCont ::

105− forall m r k v.

106− (MEq k m, Monad m) =>

107− r -> -- Absent continuation

108− (v -> Int -> r) -> -- Present continuation

109− Hash -> -- The hash of the key

110− k ->

111− Int -> -- The offset of the subkey in the hash.

112− HashMap k v ->

113− m r

114−lookupCont absent present !h0 !k0 !s0 !m0 = go h0 k0 s0 m0

115− where

116− go :: Hash -> k -> Int -> HashMap k v -> m r

117− go !_ !_ !_ Empty = pure absent

118− go h k _ (Leaf hx (L kx x))

119− | h == hx =

120− k === kx <&> \eq ->

121− if eq

122− then present x (-1)

123− else absent

124− | otherwise = pure absent

125− go h k s (BitmapIndexed b v)

126− | b .&. m == 0 = pure absent

127− | otherwise =

128− go h k (nextShift s) (A.index v (sparseIndex b m))

129− where

130− m = mask h s

131− go h k s (Full v) =

132− go h k (nextShift s) (A.index v (index h s))

133− go h k _ (Collision hx v)

134− | h == hx = lookupInArrayCont absent present k v

135− | otherwise = pure absent

136−

137−lookupInArrayCont ::

138− forall m r k v.

139− (MEq k m, Monad m) =>

140− r ->

141− (v -> Int -> r) ->

142− k ->

143− A.Array (Leaf k v) ->

144− m r

145−lookupInArrayCont absent present k0 ary0 = go k0 ary0 0 (A.length ary0)

146− where

147− go :: k -> A.Array (Leaf k v) -> Int -> Int -> m r

148− go !k !ary !i !n

149− | i >= n = pure absent

150− | otherwise = case A.index ary i of

151− (L kx v) ->

152− k === kx >>= \eq ->

153− if eq

154− then pure $ present v i

155− else go k ary (i + 1) n

src/Nock.hs+89−110

@@ -1,15 +1,29 @@

1{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

2

3−module Nock (tar, hax, fas, cell, atom, Annotation (..), Noun) where

3+module Nock (tar, hax, fas, cell, atom, Annotation (..), Noun, RawNoun (..)) where

4−

4+

5−import Data.Bits

5+import Control.DeepSeq (NFData)

6−import Data.Functor ((<&>))

6+import Data.Hashable

7−import Effectful

7+import GHC.Generics (Generic)

8−import Effectful.State.Static.Local qualified as SEL

8+import Numeric.Natural

9−import GHC.Base

9+

10−import GHC.Num

10+data Annotation = Annotation

11−import GHC.Num.BigNat (bigNatAddWord#, bigNatFromWord2#)

11+ { hash :: Int

12−import Nock.Types

12+ }

13+ deriving stock (Show, Generic)

14+ deriving anyclass (NFData)

15+

16+atom :: Natural -> Noun

17+atom nat = Atom nat Annotation {hash = hash nat}

18+

19+cell :: Noun -> Noun -> Noun

20+cell lhs rhs =

21+ Cell

22+ lhs

23+ rhs

24+ Annotation

25+ { hash = hash ((annotation lhs).hash, (annotation rhs).hash)

26+ }

13

27

14sig :: Noun

28sig :: Noun

15sig = atom 0

29sig = atom 0

@@ -17,119 +31,84 @@ sig = atom 0

17one :: Noun

31one :: Noun

18one = atom 1

32one = atom 1

19

33

20−two :: Noun

34+annotation :: RawNoun ann -> ann

21−two = atom 2

35+annotation (Atom _ ann) = ann

36+annotation (Cell _ _ ann) = ann

22

37

23−three :: Noun

38+data RawNoun ann

24−three = atom 3

39+ = Atom !Natural ann

40+ | Cell (RawNoun ann) (RawNoun ann) ann

41+ deriving stock (Generic, Show)

42+ deriving anyclass (NFData)

25

43

26−four :: Noun

44+instance Eq (RawNoun ann) where

27−four = atom 4

45+ (Atom lhs _) == (Atom rhs _) = lhs == rhs

46+ (Cell lhslhs lhsrhs _) == (Cell rhslhs rhsrhs _) = lhslhs == rhslhs && lhsrhs == rhsrhs

47+ _ == _ = False

28

48

29−twoThree :: Noun

49+hashEq :: Noun -> Noun -> Bool

30−twoThree = cell two three

50+hashEq (Atom lhsNat lhsAnn) (Atom rhsNat rhsAnn) =

51+ lhsAnn.hash == rhsAnn.hash && lhsNat == rhsNat

52+hashEq (Cell lhslhs lhsrhs lhsAnn) (Cell rhslhs rhsrhs rhsAnn) =

53+ lhsAnn.hash == rhsAnn.hash && hashEq lhslhs rhslhs && hashEq lhsrhs rhsrhs

54+hashEq _ _ = False

31

55

32−sigOne :: Noun

56+type Noun = RawNoun Annotation

33−sigOne = cell sig one

34

57

35wut :: Noun -> Noun

58wut :: Noun -> Noun

36wut Cell {} = sig

59wut Cell {} = sig

37wut Atom {} = one

60wut Atom {} = one

38

61

39lus :: Noun -> Noun

62lus :: Noun -> Noun

40−lus ~(Atom nat _) = atom $ case nat of

63+lus ~(Atom nat _) = atom (nat + 1)

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##)

45

64

46−tis :: Noun -> Noun -> Eff es Noun

65+tis :: Noun -> Noun

47−tis lhs rhs = pure $ if lhs == rhs then sig else one

66+tis ~(Cell lhs rhs _) = if hashEq lhs rhs then sig else one

48

67

49−fas# :: Word# -> Noun -> Noun

68+fas :: Noun -> Noun

50−fas# lhs rhs =

69+fas ~(Cell ~(Atom lhs _) rhs _) =

51 case lhs of

70 case lhs of

52− 1## -> rhs

71+ 1 -> rhs

53− 2## -> case rhs of

72+ 2 -> case rhs of

54 ~(Cell lhs' _ _) -> lhs'

73 ~(Cell lhs' _ _) -> lhs'

55− 3## -> case rhs of

74+ 3 -> case rhs of

56 ~(Cell _ rhs' _) -> rhs'

75 ~(Cell _ rhs' _) -> rhs'

57− n ->

76+ n

58− let rest = fas# (uncheckedShiftRL# n 1#) rhs

77+ | n > 0 ->

59− in case and# 1## n of

78+ let (d, m) = divMod n 2

60− 1## -> fas# 3## rest

61− _ -> fas# 2## rest

62−

63−fas :: Natural -> Noun -> Noun

64−fas (NS w) rhs = fas# w rhs

65−fas n rhs =

66− let rest = fas (unsafeShiftR n 1) rhs

67− in if testBit n 0

68− then fas 3 rest

69− else fas 2 rest

70−

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

78−

79−hax :: Natural -> Noun -> Noun -> Noun

80−hax (NS n) b c = hax# n b c

81−hax n b c =

82− let a = unsafeShiftR n 1

83− in if testBit n 0

79+ in if m == 0

84− then hax a (cell (fas (n - 1) c) b) c

80+ then fas (cell (atom 2) (fas (cell (atom d) rhs)))

85− else hax a (cell b (fas (n + 1) c)) c

81+ else fas (cell (atom 3) (fas (cell (atom d) rhs)))

86−

87−tar :: Noun -> Eff es Noun

88−tar ~(Cell subject ~(Cell a b _) _) = tar' a b subject

89−

90−tar' :: Noun -> Noun -> Noun -> Eff es Noun

91−tar' b c subject = case b of

92− Cell x y _ -> case c of

93− ~(Cell l k _) -> cell <$> tar' x y subject <*> tar' l k subject

94− Atom (NB _) _ -> undefined

82+ _ -> undefined

83+

84+hax :: Noun -> Noun

85+hax ~(Cell ~(Atom n _) ~(Cell b c _) _) =

86+ let (a, m) = divMod n 2

95− Atom (NS n) _ -> case n of

87+ in case n of

96− 0## -> case c of

88+ 1 -> b

97− ~(Atom nat _) -> pure $ fas nat subject

89+ _ | m == 0 -> hax (cell (atom a) (cell (cell b (fas (cell (atom $ a + a + 1) c))) c))

98− 1## -> pure c

90+ _ -> hax (cell (atom a) (cell (cell (fas (cell (atom $ a + a) c)) b) c))

99− 3## -> case c of

91+

100− ~(Cell l k _) -> wut <$> tar' l k subject

92+tar :: Noun -> Noun

101− 4## -> case c of

93+tar ~(Cell a ~(Cell b c _) _) = case b of

102− ~(Cell l k _) -> lus <$> tar' l k subject

94+ Cell x y _ -> cell (tar (cell a (cell x y))) (tar (cell a c))

95+ Atom n _ -> case n of

96+ 0 -> fas $ cell c a

97+ 1 -> c

98+ 3 -> wut $ tar $ cell a c

99+ 4 -> lus $ tar $ cell a c

103 _ -> case c of

100 _ -> case c of

104− ~(Cell x ~(Cell h j _) _) -> case n of

101+ ~(Cell x y _) -> case n of

105− 2## -> case x of

102+ 2 -> tar $ cell (tar $ cell a x) (tar $ cell a y)

106− ~(Cell l k _) ->

103+ 5 -> tis $ cell (tar $ cell a x) (tar $ cell a y)

107− tar' l k subject >>= \case

104+ 7 -> tar $ cell (tar $ cell a x) y

108− ~formula@(Cell battery ~(Cell sample _ _) _) ->

105+ 8 -> tar $ cell (cell (tar $ cell a x) a) y

109− -- if traceShowId battery == Nock.Jets.add

106+ 9 -> tar $ cell (tar $ cell a y) $ cell (atom 2) (cell (cell sig one) (cell sig x))

110− -- then error "Found it!"

107+ 6 -> case y of

111− tar' h j subject >>= \case

108+ ~(Cell c' d' _) -> tar $ cell a $ tar $ cell (cell c' d') $ cell sig $ tar $ cell (cell (atom 2) (atom 3)) $ cell sig $ tar $ cell a (cell (atom 4) (cell (atom 4) x))

112− ~(Cell u v _) -> tar' u v formula

113− 5## -> case x of

114− ~(Cell l k _) -> do

115− p <- tar' h j subject

116− q <- tar' l k subject

117− tis p q

118− 7## -> case x of

119− ~(Cell l k _) -> tar' l k subject >>= tar' h j

120− 8## -> case x of

121− ~(Cell l k _) -> do

122− p <- tar' l k subject

123− tar' h j (cell p subject)

124− 9## -> tar' h j subject >>= tar' two (cell sigOne (cell sig x))

125− 6## -> do

126− p <- tar' four (cell four x) subject

127− q <- tar' sig p twoThree

128− tar' sig q (cell h j) >>= \case

129− ~(Cell u v _) -> tar' u v subject

130− 10## -> case x of

109+ 10 -> case x of

131− ~(Cell ~(Atom b' _) ~(Cell u v _) _) -> hax b' <$> tar' u v subject <*> tar' h j subject

110+ ~(Cell b' c' _) -> hax $ cell b' $ cell (tar (cell a c')) $ tar $ cell a y

132− 11## -> case x of

111+ 11 -> case x of

133− Cell _ ~(Cell u v _) _ -> tar' h j subject

112+ Cell _ c' _ -> tar $ cell (cell (tar $ cell a c') (tar $ cell a y)) $ cell sig (atom 3)

134− Atom _ _ -> tar' h j subject

113+ Atom _ _ -> tar $ cell a y

135− _ -> undefined

114+ u -> error $ show u

src/Nock/Cue.hsdeleted−98

@@ -1,98 +0,0 @@

1−module Nock.Cue (cue, rub) where

2−

3−import Control.Monad.Trans.Class

4−import Control.Monad.Trans.State

5−import Data.Binary.Bits.BitOrder

6−import Data.Binary.Bits.Get

7−import Data.Binary.Get (runGet)

8−import Data.Bits

9−import Data.ByteString.Lazy (ByteString)

10−import Data.Map (Map)

11−import Data.Map qualified as M

12−import GHC.Base (Int (..), Word (..), Word#, int2Word#, minusWord#, or#, shiftL#, word2Int#)

13−import GHC.Num

14−import Nock.Types

15−

16−type BitParser = StateT (Int, Map Int Noun) BitGet

17−

18−parseBit# :: BitParser Int

19−parseBit# = do

20− (counter, m) <- get

21− b <- lift getBool#

22− put (counter + 1, m)

23− pure b

24−

25−parseBits# :: Word# -> BitParser Natural

26−parseBits# 0## = pure 0

27−parseBits# n = do

28− I# b <- parseBit#

29− rest <- parseBits# (n `minusWord#` 1##)

30− pure $ (rest `shiftL` 1) `naturalOr` NS (int2Word# b)

31−

32−getOffset :: BitParser Int

33−getOffset = fst <$> get

34−

35−getMapping :: BitParser (Map Int Noun)

36−getMapping = snd <$> get

37−

38−putMapping :: Map Int Noun -> BitParser ()

39−putMapping m = do

40− (offset, _) <- get

41− put (offset, m)

42−

43−cue :: ByteString -> Noun

44−cue = runGet (runBitGet . withBitOrder LL . flip evalStateT (0, M.empty) $ cue')

45−

46−cue' :: BitParser Noun

47−cue' = do

48− offset <- getOffset

49− I# isNotAtom <- parseBit#

50− case isNotAtom of

51− 0# -> do

52− a' <- rub'

53− let a = atom a'

54− m <- getMapping

55− putMapping $ M.insert offset a m

56− pure a

57− _ -> do

58− I# isRef <- parseBit#

59− case isRef of

60− 0# -> do

61− x <- cue'

62− y <- cue'

63− let c = cell x y

64− m <- getMapping

65− putMapping $ M.insert offset c m

66− pure c

67− _ -> do

68− ref <- rub'

69− let ref# = case ref of

70− NS w -> I# (word2Int# w)

71− _ -> undefined

72− m <- getMapping

73− case M.lookup ref# m of

74− Nothing -> undefined

75− Just a -> pure a

76−

77−rub :: ByteString -> Natural

78−rub = runGet (runBitGet . withBitOrder LL . flip evalStateT (0, M.empty) $ rub')

79−

80−rub' :: BitParser Natural

81−rub' = do

82− parseBit# >>= \case

83− I# 0# -> do

84− W# lengthOfLength <- countZeros 0

85− lengthBits <- parseBits# lengthOfLength

86− let lengthBits# = case lengthBits of

87− NS w -> w

88− _ -> undefined

89− let lent = lengthBits# `or#` (1## `shiftL#` word2Int# lengthOfLength)

90− parseBits# lent

91− _ -> pure 0

92−

93−countZeros :: Word -> BitParser Word

94−countZeros n = do

95− I# b <- parseBit#

96− case b of

97− 0# -> countZeros (n + 1)

98− _ -> pure n

src/Nock/Jam.hs+98−103

@@ -1,128 +1,123 @@

1−{-# LANGUAGE NoMonomorphismRestriction #-}

1+module Nock.Jam (jam, cue, mat, rub) where

2

3−module Nock.Jam (jam, mat) where

4−

5−import Control.Monad.Identity

6−import Control.Monad.State.Strict (MonadState (..))

7import Control.Monad.Trans.Class

3import Control.Monad.Trans.Class

8−import Control.Monad.Trans.State hiding (get, put)

4+import Control.Monad.Trans.State

9import Data.Binary.Bits.BitOrder

5import Data.Binary.Bits.BitOrder

10−import Data.Binary.Bits.Put qualified as Put

6+import Data.Binary.Bits.Get

7+import Data.Binary.Bits.Put

8+import Data.Binary.Get (runGet)

11import Data.Binary.Put (runPut)

9import Data.Binary.Put (runPut)

12import Data.Bits

10import Data.Bits

13import Data.ByteString.Lazy (ByteString)

11import Data.ByteString.Lazy (ByteString)

14−import Data.Map.Strict (Map)

12+import Data.Map (Map)

15−import Data.Map.Strict qualified as M

13+import Data.Map qualified as M

16−import GHC.Base (Word (..), Word#, int2Word#, isTrue#, leWord#, plusWord#, timesWord#)

14+import Nock

17−import GHC.Int (Int (..))

15+import Numeric.Natural

18−import GHC.Num

16+

19−import Nock.Types

17+type BitParser = StateT (Int, Map Int Noun) BitGet

20−

18+

21−type BitPrinterM = StateT (Natural, Map Noun Natural) Put.BitPut

19+parseBit :: BitParser Bool

22−

20+parseBit = do

23−class (MonadState (Natural, Map Noun Natural) m) => BitPrinter m where

24− putBit# :: (BitPrinter m) => Word# -> m ()

25− putBool :: Bool -> m ()

26−

27−instance BitPrinter (StateT (Natural, Map Noun Natural) Identity) where

28− putBit# _ = do

29− (counter, m) <- get

21+ (counter, m) <- get

30− put (counter + 1, m)

22+ b <- lift getBool

31− putBool _ = do

32− (counter, m) <- get

33− put (counter + 1, m)

23+ put (counter + 1, m)

34−

24+ pure b

35−instance BitPrinter BitPrinterM where

25+

36− putBit# w = do

26+parseBits :: Int -> BitParser [Bool]

37− (counter, m) <- get

27+parseBits 0 = pure []

38− lift $ Put.putBool# w

28+parseBits n = do

39− put (counter + 1, m)

29+ b <- parseBit

40− putBool b = do

30+ (b :) <$> parseBits (n - 1)

41− (counter, m) <- get

31+

42− lift $ Put.putBool b

32+getOffset :: BitParser Int

43− put (counter + 1, m)

44−

45−getOffset :: (BitPrinter m) => m Natural

46getOffset = fst <$> get

33getOffset = fst <$> get

47

34

48−getMapping :: (BitPrinter m) => m (Map Noun Natural)

35+cue :: ByteString -> Noun

49−getMapping = snd <$> get

36+cue = runGet (runBitGet . withBitOrder LL . flip evalStateT (0, M.empty) $ cue')

50

37

51−putMapping :: (BitPrinter m) => Noun -> Natural -> m ()

38+cue' :: BitParser Noun

52−putMapping idx n = do

39+cue' = do

40+ offset <- getOffset

41+ isNotAtom <- parseBit

42+ case isNotAtom of

43+ False -> do

44+ a' <- rub'

45+ let a = atom a'

46+ (offset, m) <- get

47+ put (offset, M.insert offset a m)

48+ pure a

49+ True -> do

50+ isNotRef <- parseBit

51+ case isNotRef of

52+ False -> do

53+ x <- cue'

54+ y <- cue'

55+ let c = cell x y

53− (offset, m) <- get

56+ (offset, m) <- get

54− put (offset, M.insert idx n m)

57+ put (offset, M.insert offset c m)

58+ pure c

59+ True -> do

60+ ref <- rub'

61+ (_, m) <- get

62+ case M.lookup (fromIntegral ref) m of

63+ Nothing -> undefined

64+ Just a -> pure a

55

65

56jam :: Noun -> ByteString

66jam :: Noun -> ByteString

57−jam n = runPut . Put.runBitPut . withBitOrder LL . flip evalStateT (0, M.empty) $ jam' n

67+jam n = runPut . runBitPut . withBitOrder LL $ jam' n

58−

68+

59−jam' :: (BitPrinter m) => Noun -> m ()

69+jam' :: Noun -> BitPut ()

60−jam' n = do

61− offset <- getOffset

62− mapping <- getMapping

63− case M.lookup n mapping of

64− Nothing -> do

65− putMapping n offset

66− case n of

67− (Atom a _) -> do

70+jam' (Atom n _) = do

68− putBit# 0##

71+ putBool False

69− mat' a

72+ mat' n

70− (Cell lhs rhs _) -> do

73+jam' (Cell lhs rhs _) = do

71− putBit# 1##

74+ putBool True

72− putBit# 0##

75+ putBool False

73− jam' lhs

76+ jam' lhs

74− jam' rhs

77+ jam' rhs

75− Just ref -> do

76− case n of

77− Cell {} -> do

78− putBit# 1##

79− putBit# 1##

80− mat' ref

81− (Atom a _) -> do

82− if isTrue# (matSize a `leWord#` matSize ref)

83− then do

84− putBit# 0##

85− mat' a

86− else do

87− putBit# 1##

88− putBit# 1##

89− mat' ref

90

78

91mat :: Natural -> ByteString

79mat :: Natural -> ByteString

92−mat n = runPut . Put.runBitPut . withBitOrder LL . flip evalStateT (0, M.empty) $ mat' n

80+mat n = runPut . runBitPut . withBitOrder LL $ mat' n

93

81

94−mat' :: (BitPrinter m) => Natural -> m ()

82+mat' :: Natural -> BitPut ()

95−mat' 0 = putBit# 1##

83+mat' 0 = putBool True

96mat' n = do

84mat' n = do

97− let bitsLength = countBits# n

85+ let bits = numToBits n

86+ bitsLength = length bits

98− lengthBits = init $ numToBits (W# bitsLength)

87+ lengthBits = init $ numToBits bitsLength

99− putBit# 0##

88+ putBool False

100 putBits $ replicate (length lengthBits) False

89 putBits $ replicate (length lengthBits) False

101− putBit# 1##

90+ putBool True

102 putBits lengthBits

91 putBits lengthBits

103− putNumToBits# n

92+ putBits bits

104

93

105−matSize :: Natural -> Word#

106−matSize 0 = 1##

107−matSize n =

108− let bitsLength = countBits# n

109− !(I# lengthBits) = length $ init $ numToBits (W# bitsLength)

110− in 2## `plusWord#` (int2Word# lengthBits `timesWord#` 2##) `plusWord#` bitsLength

111−

112−putBits :: (BitPrinter m) => [Bool] -> m ()

94+putBits :: [Bool] -> BitPut ()

113putBits [] = pure ()

95putBits [] = pure ()

114putBits (x : xs) = putBool x >> putBits xs

96putBits (x : xs) = putBool x >> putBits xs

115

97

98+rub :: ByteString -> Natural

99+rub = runGet (runBitGet . withBitOrder LL . flip evalStateT (0, M.empty) $ rub')

100+

101+rub' :: BitParser Natural

102+rub' = do

103+ parseBit >>= \case

104+ True -> pure 0

105+ False -> do

106+ lengthOfLength <- countZeros 0

107+ lengthBits <- (++ [True]) <$> parseBits lengthOfLength

108+ let lent = bitsToNum lengthBits

109+ bitsToNum <$> parseBits lent

110+

111+countZeros :: Int -> BitParser Int

112+countZeros n = do

113+ b <- parseBit

114+ case b of

115+ True -> pure n

116+ False -> countZeros (n + 1)

117+

116numToBits :: (Bits a, Integral a) => a -> [Bool]

118numToBits :: (Bits a, Integral a) => a -> [Bool]

117numToBits n | n <= 0 = []

119numToBits n | n <= 0 = []

118numToBits n = ((n .&. 1) == 1) : numToBits (shiftR n 1)

120numToBits n = ((n .&. 1) == 1) : numToBits (shiftR n 1)

119

121

120−countBits# :: Natural -> Word#

122+bitsToNum :: (Bits a, Integral a) => [Bool] -> a

121−countBits# (NS 0##) = 0##

123+bitsToNum = foldr (\b acc -> shiftL acc 1 .|. if b then 1 else 0) 0

122−countBits# n = 1## `plusWord#` countBits# (n `naturalShiftR#` 1##)

123−

124−putNumToBits# :: (BitPrinter m) => Natural -> m ()

125−putNumToBits# (NS 0##) = pure ()

126−putNumToBits# n = case n .&. 1 of

127− NS w -> putBit# w >> putNumToBits# (n `naturalShiftR#` 1##)

128− _ -> undefined

src/Nock/Jets.hsdeleted−23

@@ -1,23 +0,0 @@

1−{-# LANGUAGE TemplateHaskell #-}

2−

3−module Nock.Jets (add, dec, decJam, decNoun) where

4−

5−import Data.ByteString (ByteString)

6−import Data.ByteString.Lazy qualified as BSL

7−import Data.FileEmbed (embedFileRelative)

8−import Nock.Cue

9−import Nock.Jam

10−import Nock.Parser qualified

11−import Nock.Types

12−

13−decJam :: ByteString

14−decJam = $(embedFileRelative "res/dec.jam")

15−

16−decNoun :: Noun

17−decNoun = cue $ BSL.fromStrict decJam

18−

19−dec :: Noun

20−dec = Nock.Parser.noun "[8 [1 0] 8 [1 6 [5 [0 30] 4 0 6] [0 6] 9 2 10 [6 4 0 6] 0 1] 9 2 0 1]"

21−

22−add :: Noun

23−add = Nock.Parser.noun "[ 6 [5 [1 0] 0 12] [0 13] 9 2 10 [6 [8 [9 21 0 7] 9 2 10 [6 0 28] 0 2] 4 0 13] 0 1 ]"

src/Nock/Mug.hsdeleted−34

@@ -1,34 +0,0 @@

1−module Nock.Mug (Mug, mugBS, mugAtom, mugBoth) where

2−

3−import Data.Bits

4−import Data.ByteString (ByteString)

5−import Data.ByteString.Builder

6−import Data.ByteString.Lazy (toStrict)

7−import Data.Hash.Murmur (murmur3)

8−import Data.Word (Word32)

9−import Nock.Types

10−

11−type Mug = Word32

12−

13−mugBS :: ByteString -> Word32

14−mugBS = mum 0xcafe_babe 0x7fff

15−

16−mugAtom :: Atom -> Word32

17−mugAtom = mugBS . atomByteString

18−

19−mugBoth :: Word32 -> Word32 -> Word32

20−mugBoth m n =

21− mum 0xdead_beef 0xfffe $

22− toStrict $

23− toLazyByteString (word32LE m <> word32LE n)

24−

25−mum :: Word32 -> Word32 -> ByteString -> Word32

26−mum syd fal key = go syd 0

27− where

28− go syd 8 = fal

29− go syd i =

30− let haz = murmur3 syd key

31− ham = shiftR haz 31 `xor` (haz .&. 0x7fff_ffff)

32− in if ham /= 0

33− then ham

34− else go (syd + 1) (i + 1)

src/Nock/Parser.hs+1−1

@@ -5,7 +5,7 @@ module Nock.Parser (noun) where

5import Control.Applicative

6import Data.Text.Lazy as TL

7import Data.Void (Void)

8−import Nock.Types

8+import Nock

9import Text.Megaparsec

10import Text.Megaparsec.Char

11import Text.Megaparsec.Char.Lexer (decimal)

src/Nock/Printer.hs+9−1

@@ -1,6 +1,14 @@

1−module Nock.Printer () where

1+module Nock.Printer (pretty) where

2

3import Data.Text.Lazy qualified as TL

4import Data.Text.Lazy.Builder qualified as TLB

5import Data.Text.Lazy.Builder.Int qualified as TLB

6import Nock

7+

8+pretty :: RawNoun ann -> TL.Text

9+pretty noun = TLB.toLazyText $ pretty' noun False

10+

11+pretty' :: RawNoun ann -> Bool -> TLB.Builder

12+pretty' (Atom a _) _ = TLB.decimal a

13+pretty' (Cell lhs rhs _) True = pretty' lhs False <> " " <> pretty' rhs True

14+pretty' (Cell lhs rhs _) False = "[" <> pretty' lhs False <> " " <> pretty' rhs True <> "]"

src/Nock/Types.hsdeleted−114

@@ -1,114 +0,0 @@

1−module Nock.Types

2− ( pretty,

3− Noun (..),

4− Atom,

5− atomShortByteString,

6− atomByteString,

7− Annotation (..),

8− atom,

9− cell,

10− nounEq,

11− EqualityCache,

12− annotation,

13− )

14−where

15−

16−import Control.DeepSeq

17−import Data.ByteString (ByteString)

18−import Data.ByteString.Short

19−import Data.HashMap.Strict qualified as HM

20−import Data.Text.Lazy qualified as TL

21−import Data.Text.Lazy.Builder qualified as TLB

22−import Data.Text.Lazy.Builder.Int qualified as TLB

23−import Effectful

24−import Effectful.State.Static.Local qualified as SEL

25−import GHC.Generics

26−import GHC.Natural

27−import GHC.Num (Natural (..))

28−import GHC.Num.BigNat (bigNatFromWord#)

29−import System.Mem.StableName

30−import Test.QuickCheck

31−

32−newtype EqualityCache = EqualityCache (HM.HashMap (StableName Noun, StableName Noun) Bool)

33− deriving newtype (Semigroup, Monoid)

34−

35−nounEq :: (SEL.State EqualityCache :> es, IOE :> es) => Noun -> Noun -> Eff es Bool

36−nounEq x y = do

37− xName <- liftIO $ makeStableName x

38− yName <- liftIO $ makeStableName y

39− EqualityCache cache <- SEL.get

40− case HM.lookup (xName, yName) cache of

41− Just res -> pure res

42− Nothing -> do

43− res <- case (x, y) of

44− (Atom xa _, Atom ya _) -> pure $ xa == ya

45− (Cell xLhs xRhs _, Cell yLhs yRhs _) -> do

46− lhsRes <- nounEq xLhs yLhs

47− if lhsRes then nounEq xRhs yRhs else pure False

48− _ -> pure False

49− SEL.put $ EqualityCache $ HM.insert (xName, yName) res $ HM.insert (yName, xName) res $ cache

50− pure res

51−

52−data Annotation = Annotation

53− deriving stock (Show, Generic)

54− deriving anyclass (NFData)

55−

56−atom :: Natural -> Noun

57−atom nat = Atom nat Annotation {}

58−

59−cell :: Noun -> Noun -> Noun

60−cell lhs rhs =

61− Cell

62− lhs

63− rhs

64− Annotation

65− {

66− }

67−

68−annotation :: Noun -> Annotation

69−annotation (Atom _ ann) = ann

70−annotation (Cell _ _ ann) = ann

71−

72−type Atom = Natural

73−

74−atomShortByteString :: Atom -> ShortByteString

75−atomShortByteString (NB ba) = SBS ba

76−atomShortByteString (NS w) = SBS (bigNatFromWord# w)

77−

78−atomByteString :: Atom -> ByteString

79−atomByteString = fromShort . atomShortByteString

80−

81−data Noun

82− = Atom !Atom Annotation

83− | Cell !Noun !Noun Annotation

84− deriving stock (Generic)

85− deriving anyclass (NFData)

86−

87−instance Eq Noun where

88− (Cell lhsA lhsB _) == (Cell rhsA rhsB _) = lhsA == rhsA && lhsB == rhsB

89− (Atom a _) == (Atom b _) = a == b

90− _ == _ = False

91−

92−instance Ord Noun where

93− Atom {} <= Cell {} = True

94− Cell {} <= Atom {} = False

95− Atom n _ <= Atom m _ = n <= m

96− Cell a b _ <= Cell c d _ = (a, b) <= (c, d)

97−

98−instance Arbitrary Noun where

99− arbitrary =

100− oneof

101− [ atom <$> arbitrarySizedNatural,

102− cell <$> arbitrary <*> arbitrary

103− ]

104−

105−instance Show Noun where

106− show = TL.unpack . pretty

107−

108−pretty :: Noun -> TL.Text

109−pretty noun = TLB.toLazyText $ pretty' noun False

110−

111−pretty' :: Noun -> Bool -> TLB.Builder

112−pretty' (Atom a _) _ = TLB.decimal a

113−pretty' (Cell lhs rhs _) True = pretty' lhs False <> " " <> pretty' rhs True

114−pretty' (Cell lhs rhs _) False = "[" <> pretty' lhs False <> " " <> pretty' rhs True <> "]"

stack.yaml+3−2

@@ -23,7 +23,8 @@ nix:

23#

24# resolver: ./custom-snapshot.yaml

25# resolver: https://example.com/snapshots/2018-01-01.yaml

26−resolver: lts-23.21

26+resolver:

27+ url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/21/6.yaml

27

28

28# User packages to be built.

29# User packages to be built.

29# Various formats can be used as shown in the example below.

30# Various formats can be used as shown in the example below.

@@ -51,7 +52,7 @@ extra-deps:

51# - git: https://github.com/hsyl20/binary-bits.git

52# - git: https://github.com/hsyl20/binary-bits.git

52# commit: 8aa66ff52166ff283b66c7c322108fcb4aa55192

53# commit: 8aa66ff52166ff283b66c7c322108fcb4aa55192

53- git: https://github.com/ilyakooo0/binary-bits

54- git: https://github.com/ilyakooo0/binary-bits

54− commit: 21adca7da6e378c8e3cc7bb1afa9dd441a721016

55+ commit: f58ae476ff50dfc277f8dd603142b7ce864b8e03

55# Override default flag values for local packages and extra-deps

56# Override default flag values for local packages and extra-deps

56# flags: {}

57# flags: {}

57

58

stack.yaml.lock+9−8

@@ -5,19 +5,20 @@

5

6packages:

7- completed:

8− commit: 21adca7da6e378c8e3cc7bb1afa9dd441a721016

8+ commit: f58ae476ff50dfc277f8dd603142b7ce864b8e03

9 git: https://github.com/ilyakooo0/binary-bits

10 name: binary-bits

11 pantry-tree:

12− sha256: b6f354e26ca7563ad73a3234cd43918ba8edfb5bee7c5e5f8a9173c9109bba66

12+ sha256: d4886449b9be758d88537eb50a5f9e7c456398c4e1a0b38eb6a2eba07ce71300

13− size: 907

13+ size: 808

14 version: '0.6'

15 original:

16− commit: 21adca7da6e378c8e3cc7bb1afa9dd441a721016

16+ commit: f58ae476ff50dfc277f8dd603142b7ce864b8e03

17 git: https://github.com/ilyakooo0/binary-bits

18snapshots:

19- completed:

20− sha256: f4a61482dcad21151331bf84ec85bee9be43965f143791fa4bb202ac1e443e1b

20+ sha256: 2e7d4a730d8eb5373b2d383fac84efcf7c81e3b7a5fce71b4c2e19a1768f25a6

21− size: 683833

21+ size: 640239

22− url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/23/21.yaml

22+ url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/21/6.yaml

23− original: lts-23.21

23+ original:

24+ url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/21/6.yaml

tests/Main.hs+4−18

@@ -4,36 +4,23 @@ import Control.Monad

4import Data.ByteString.Lazy qualified as BSL

5import Data.Function

6import Data.Text.Lazy.Encoding as TL

7−import Effectful

8−import Effectful.State.Static.Local qualified as SEL

9import Nock

7import Nock

10−import Nock.Cue

11−import Nock.Jam

12−import Nock.Jets

13import Nock.Parser qualified

8import Nock.Parser qualified

14−import Nock.Types

9+import Nock.Printer

15import System.FilePath.Posix

10import System.FilePath.Posix

16import System.Process.Typed

11import System.Process.Typed

17import Test.Tasty

12import Test.Tasty

18import Test.Tasty.Golden

13import Test.Tasty.Golden

19−import Test.Tasty.HUnit (testCase, (@?=))

20−import Test.Tasty.QuickCheck

21

14

22main :: IO ()

15main :: IO ()

23main = do

16main = do

24 spec <- goldenTest

17 spec <- goldenTest

25− defaultMain $

18+ defaultMain $ spec

26− testGroup

27− "nock"

28− [ spec,

29− testProperty "cue . jam == id" (\noun -> noun === (cue . jam) noun),

30− testCase "" (decJam @?= BSL.toStrict ((jam . cue) (BSL.fromStrict decJam)))

31− ]

32

19

33goldenTest :: IO TestTree

20goldenTest :: IO TestTree

34goldenTest = do

21goldenTest = do

35 files <- findByExtension [".hoon"] "tests/golden"

22 files <- findByExtension [".hoon"] "tests/golden"

36− fmap (testGroup "golden") $ forM files $ \source -> do

23+ fmap (testGroup "nock") $ forM files $ \source -> do

37 let target = replaceExtension source ".nock"

24 let target = replaceExtension source ".nock"

38 pure $ goldenVsString (takeBaseName source) target $ do

25 pure $ goldenVsString (takeBaseName source) target $ do

39 hoon <- BSL.readFile source

26 hoon <- BSL.readFile source

@@ -43,6 +30,5 @@ goldenTest = do

43 $ proc "urbit" ["eval"]

30 $ proc "urbit" ["eval"]

44 & setStdin (byteStringInput hoon)

31 & setStdin (byteStringInput hoon)

45 & setStderr nullStream

32 & setStderr nullStream

46− noun <- runEff . SEL.evalState (mempty :: EqualityCache) . tar $ cell (atom 0) nock

47− let result = TL.encodeUtf8 . pretty $ noun

33+ let result = TL.encodeUtf8 . Nock.Printer.pretty . tar $ cell (atom 0) nock

48 pure result

34 pure result

tests/golden/add.hoon+13−9

@@ -1,16 +1,19 @@

1!=

2=>

3|%

4−++ foo 1

5−++ baz |= x=@ x

6++ dec

4++ dec

5+ ~/ %dec

6+ :: unsigned decrement by one.

7−|= a=@

7+ |= a=@

8+ ~_ leaf+"decrement-underflow"

8−=/ b 0

9+ ?< =(0 a)

10+ =+ b=0

11+ :: decremented integer

9−|- ^- @

12+ |- ^- @

13+ ?: =(a +(b)) b

10−?. =(a +(b)) $(b +(b)) b

14+ $(b +(b))

11−++ bar 2

12++ add

15++ add

13− :: ~/ %add

16+ ~/ %add

14 :: unsigned addition

17 :: unsigned addition

15 ::

18 ::

16 :: a: augend

19 :: a: augend

@@ -21,4 +24,5 @@

21 ?: =(0 a) b

24 ?: =(0 a) b

22 $(a (dec a), b +(b))

25 $(a (dec a), b +(b))

23--

26--

24−(add 3 5)

27+%+ add

28+234 111

tests/golden/add.nock+1−1

@@ -1 +1 @@

1−8

1+345

tests/golden/dec.hoon+10−9

@@ -1,16 +1,17 @@

1!=

2=>

3|%

4−++ add

5− |= x=@

6− x

7−++ bar 4

8++ dec

4++ dec

5+~/ %dec

6+:: unsigned decrement by one.

9|= a=@

7|= a=@

8+~_ leaf+"decrement-underflow"

9+?< =(0 a)

10−=/ b 0

10+=+ b=0

11+:: decremented integer

11|- ^- @

12|- ^- @

13+?: =(a +(b)) b

12−?. =(a +(b)) $(b +(b)) b

14+$(b +(b))

13--

15--

14−%-

16+

15−dec

17+%- dec 8

16−5

tests/golden/dec.nock+1−1

@@ -1 +1 @@

1−4

1+7

tests/golden/mul.hoondeleted−37

@@ -1,37 +0,0 @@

1−!=

2−=>

3−|%

4−++ mul

5− ~/ %mul

6− :: unsigned multiplication

7− ::

8− :: a: multiplicand

9− :: b: multiplier

10− |: [a=`@`1 b=`@`1]

11− :: product

12− ^- @

13− =+ c=0

14− |-

15− ?: =(0 a) c

16− $(a (dec a), c (add b c))

17−++ foo 1

18−++ baz |= x=@ x

19−++ dec

20−|= a=@

21−=/ b 0

22−|- ^- @

23−?. =(a +(b)) $(b +(b)) b

24−++ bar 2

25−++ add

26− :: ~/ %add

27− :: unsigned addition

28− ::

29− :: a: augend

30− :: b: addend

31− |= [a=@ b=@]

32− :: sum

33− ^- @

34− ?: =(0 a) b

35− $(a (dec a), b +(b))

36−--

37−(mul 3 5)

tests/golden/mul.nockdeleted−1

@@ -1 +0,0 @@

1−15