4029ce9 · nock-hs · git.iko.soy

git.iko.soy/nock-hs

I think I got things working

commit4029ce95f490ff82be749d2a59363c74e5e33863 authoriko <mail@iko.soy> dateSun 13 Aug 2023, 22:59 (3 years ago) parent4862b79

3 files changed+16−13

compare with master

unifiedsplit

src/Nock.hs+12−10 tests/Main.hs+3−2 tests/golden/dec.nock+1−1

src/Nock.hs+12−10

@@ -5,6 +5,7 @@ module Nock (tar, hax, fas, cell, atom, Annotation (..), Noun, RawNoun (..)) whe

55import Data.Hashable

66import Debug.Trace (trace, traceShowId)

77import GHC.Generics (Generic)

8+import GHC.Stack

89import Numeric.Natural

910import Test.QuickCheck.Arbitrary.Generic

1011

@@ -66,10 +67,11 @@ tis ~(Cell lhs rhs _) = if hashEq lhs rhs then sig else one

6667

6768fas :: Noun -> Noun

6869fas ~(Cell ~(Atom lhs _) rhs _) =

69− case traceShowId lhs of

70+ case lhs of

7071 1 -> rhs

7172 2 -> case rhs of

72− ~(Cell lhs' _ _) -> lhs'

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

74+ _ -> undefined

7375 3 -> case rhs of

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

7577 n

@@ -81,12 +83,12 @@ fas ~(Cell ~(Atom lhs _) rhs _) =

8183 _ -> undefined

8284

8385hax :: Noun -> Noun

84−hax ~(Cell ~(Atom n _) ~(Cell a b _) _) =

85− let (d, m) = divMod n 2

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

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

8688 in case n of

87− 1 -> a

88− _ | m == 0 -> hax (cell (atom d) (cell (cell a (fas (cell (atom $ n + 1) b))) b))

89− _ -> hax (cell (atom d) (cell (cell (fas (cell (atom $ n - 1) b)) a) b))

89+ 1 -> b

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

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

9092

9193tar :: Noun -> Noun

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

@@ -104,10 +106,10 @@ tar ~(Cell a ~(Cell b c _) _) = case b of

104106 8 -> tar $ cell (cell (tar $ cell a x) a) y

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

106108 6 -> case y of

107− ~(Cell l k _) -> tar $ cell a $ tar $ cell (cell l k) $ cell sig $ tar $ cell (cell (atom 2) (atom 3)) $ cell sig $ tar $ cell a (cell (atom 4) (cell (atom 4) x))

109+ ~(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))

108110 10 -> case x of

109− ~(Cell l k _) -> hax $ cell l $ cell (tar (cell a k)) $ tar $ cell a y

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

110112 11 -> case x of

111− Cell _ k _ -> tar $ cell (cell (tar $ cell a k) (tar $ cell a y)) $ cell sig (atom 3)

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

112114 Atom _ _ -> tar $ cell a y

113115 u -> error $ show u

tests/Main.hs+3−2

@@ -32,7 +32,7 @@ main = do

3232 defaultMain $

3333 testGroup

3434 "nock"

35− [ -- spec,

35+ [ -- spec

3636 goldenTest "add",

3737 goldenTest "dec"

3838 -- goldenVsString "add" "golden/add.nock" "golden/add.result.nock" $

@@ -50,7 +50,7 @@ goldenTest name = do

5050 readProcessStdout $

5151 proc "/run/current-system/sw/bin/urbit" ["eval"]

5252 & setStdin (byteStringInput hoon)

53− let result = TL.encodeUtf8 $ Nock.Printer.pretty $ tar $ Nock.Parser.decode $ T.decodeUtf8 $ BS.toStrict output

53+ let result = TL.encodeUtf8 $ Nock.Printer.pretty $ tar $ Nock.Parser.decode $ T.decodeUtf8 $ BS.toStrict ("[0 " <> output <> "]")

5454 print result

5555 pure result

5656

@@ -58,6 +58,7 @@ goldenTest name = do

5858

5959specs :: Spec

6060specs = describe "nock" $ do

61+ tarTest "[77 [2 [1 42] [1 1 153 218]]]" "[153 218]"

6162 tarTest "[42 8 [1 0] 8 [1 6 [5 [0 7] 4 0 6] [0 6] 9 2 [0 2] [4 0 6] 0 7] 9 2 0 1]" "41"

6263 tarTest "[4 9 2.398 0 2.047]" "3"

6364 tarTest "[2 [1 1 3] 9 36 0 2.047]" "4"

tests/golden/dec.nock+1−1

@@ -1 +1 @@

1−[0 7]

1+7