git.iko.soy/nock-hs
on master help sign in
Got jam and cue working
commit391abb13218cb8874106c9d5d6003e88b2c6ffc5 authoriko <mail@iko.soy> dateFri 11 Aug 2023, 17:01 (3 years ago) parent3ff5801
4 files changed+42−4
compare with master
unifiedsplit
package.yaml+1 src/Nock.hs+1 src/Nock/Jam.hs+32−4 tests/Main.hs+8
package.yaml+1
@@ -12,6 +12,7 @@ dependencies:
1212 - QuickCheck
1313 - transformers
1414 - containers
15+ - generic-arbitrary
1516library:
1617 source-dirs: src
1718
src/Nock.hs+1
@@ -5,6 +5,7 @@ module Nock (tar, cell, atom, Annotation (..), Noun, RawNoun (..)) where
55import Data.Hashable
66import GHC.Generics (Generic)
77import Numeric.Natural
8+import Test.QuickCheck.Arbitrary.Generic
89
910data Annotation = Annotation
1011 { hash :: Int
src/Nock/Jam.hs+32−4
@@ -1,4 +1,4 @@
1−module Nock.Jam (mat, rub) where
1+module Nock.Jam (jam, cue, mat, rub) where
22
33import Control.Monad.Trans.Class
44import Control.Monad.Trans.State
@@ -28,13 +28,41 @@ parseBits :: Int -> BitParser [Bool]
2828parseBits 0 = pure []
2929parseBits n = do
3030 b <- parseBit
31− (b :) <$> parseBits (n + 1)
31+ (b :) <$> parseBits (n - 1)
3232
3333getOffset :: BitParser Int
3434getOffset = fst <$> get
3535
36−-- cue' :: BitParser Noun
37−-- cue' = do
36+cue :: ByteString -> Noun
37+cue = runGet (runBitGet . withBitOrder LL . flip evalStateT (0, M.empty) $ cue')
38+
39+cue' :: BitParser Noun
40+cue' = do
41+ offset <- getOffset
42+ isNotAtom <- parseBit
43+ case isNotAtom of
44+ False -> do
45+ a' <- rub'
46+ let a = atom a'
47+ (offset, m) <- get
48+ put (offset, M.insert offset a m)
49+ pure a
50+ True -> do
51+ isNotRef <- parseBit
52+ case isNotRef of
53+ False -> do
54+ x <- cue'
55+ y <- cue'
56+ let c = cell x y
57+ (offset, m) <- get
58+ put (offset, M.insert offset c m)
59+ pure c
60+ True -> do
61+ ref <- rub'
62+ (_, m) <- get
63+ case M.lookup (fromIntegral ref) m of
64+ Nothing -> undefined
65+ Just a -> pure a
3866
3967jam :: Noun -> ByteString
4068jam n = runPut . runBitPut . withBitOrder LL $ jam' n
tests/Main.hs+8
@@ -2,6 +2,7 @@ module Main (main) where
22
33import Data.ByteString.Lazy qualified as BSL
44import Data.Text as T
5+import Debug.Trace
56import Debug.Trace (traceShowId)
67import Nock
78import Nock.Jam
@@ -30,8 +31,15 @@ specs = describe "nock" $ do
3031 let atom = fromInteger (a * b * c * 11)
3132 in rub (mat atom) === atom
3233 )
34+ describe "cue (jam noun) = noun" $ do
35+ testJam "[77 [2 [1 42] [1 1 153 218]]]"
3336
3437tarTest :: Text -> Text -> Spec
3538tarTest source target =
3639 it (T.unpack ("*" <> source <> " = " <> target)) $
3740 tar (decode source) == decode target
41+
42+testJam :: Text -> Spec
43+testJam source =
44+ it ("cue (jam " ++ T.unpack source ++ ") = source") $
45+ cue (jam (decode source)) == decode source