38a906d · airlock · git.iko.soy

git.iko.soy/airlock

Finished cue

commit38a906d7a77df74a3a756e0fbae4ef60e823a427 authoriko <mail@iko.soy> dateMon 29 May 2023, 09:03 (3 years ago) parentace1fc2

4 files changed+166−38

compare with master

unifiedsplit

src/BitParser.elm+20−5 src/BitWriter.elm+28−5 src/Urbit.elm+78−27 tests/Test/Urbit.elm+40−1

src/BitParser.elm+20−5

@@ -5,6 +5,7 @@ module BitParser exposing

55 , bits

66 , bitsToInt

77 , fail

8+ , getOffset

89 , intBits

910 , map

1011 , rawBits

@@ -20,11 +21,12 @@ import Bytes.Encode as BE

2021

2122run : BitParser a -> Bytes -> Maybe a

2223run (BitParser f) bytes =

23− BD.decode (f { running = Nothing }) bytes |> Maybe.map Tuple.second

24+ BD.decode (f { running = Nothing, offset = 0 }) bytes |> Maybe.map Tuple.second

2425

2526

2627type alias BitParserState =

2728 { running : Maybe { byte : Int, length : Int }

29+ , offset : Int

2830 }

2931

3032

@@ -32,16 +34,27 @@ type BitParser a

3234 = BitParser (BitParserState -> BD.Decoder ( BitParserState, a ))

3335

3436

37+getOffset : BitParser Int

38+getOffset =

39+ BitParser (\state -> BD.succeed ( state, state.offset ))

40+

41+

3542bit : BitParser Int

3643bit =

3744 BitParser

38− (\{ running } ->

45+ (\{ running, offset } ->

46+ let

47+ newOffset =

48+ offset + 1

49+ in

3950 case running of

4051 Nothing ->

4152 BD.unsignedInt8

4253 |> BD.map

4354 (\i ->

44− ( { running = Just { byte = Bitwise.shiftRightBy 1 i, length = 7 } }

55+ ( { running = Just { byte = Bitwise.shiftRightBy 1 i, length = 7 }

56+ , offset = newOffset

57+ }

4558 , Bitwise.and 1 i

4659 )

4760 )

@@ -49,10 +62,12 @@ bit =

4962 Just { byte, length } ->

5063 BD.succeed

5164 (if length == 1 then

52− ( { running = Nothing }, byte )

65+ ( { running = Nothing, offset = newOffset }, byte )

5366

5467 else

55− ( { running = Just { byte = Bitwise.shiftRightBy 1 byte, length = length - 1 } }

68+ ( { running = Just { byte = Bitwise.shiftRightBy 1 byte, length = length - 1 }

69+ , offset = newOffset

70+ }

5671 , Bitwise.and 1 byte

5772 )

5873 )

src/BitWriter.elm+28−5

@@ -3,6 +3,7 @@ module BitWriter exposing

33 , bit

44 , bits

55 , empty

6+ , getOffset

67 , run

78 )

@@ -13,7 +14,7 @@ import Bytes.Encode as BE

1314

1415empty : BitWriter

1516empty =

16− BitWriter { running = Nothing, collected = BE.sequence [] }

17+ BitWriter { running = Nothing, collected = BE.sequence [], offset = 0 }

1718

1819

1920run : BitWriter -> Bytes

@@ -33,17 +34,31 @@ type BitWriter

3334 { value : Int

3435 , length : Int

3536 }

37+ , offset : Int

3638 , collected : BE.Encoder

3739 }

3840

3941

42+getOffset : BitWriter -> Int

43+getOffset (BitWriter { offset }) =

44+ offset

45+

46+

4047{-| If the given int is longer than 1 bit the behaviour is undefined

4148-}

4249bit : Int -> BitWriter -> BitWriter

43−bit b (BitWriter { running, collected }) =

50+bit b (BitWriter { running, collected, offset }) =

51+ let

52+ newOffset =

53+ offset + 1

54+ in

4455 case running of

4556 Nothing ->

46− BitWriter { running = Just { value = b, length = 1 }, collected = collected }

57+ BitWriter

58+ { running = Just { value = b, length = 1 }

59+ , collected = collected

60+ , offset = newOffset

61+ }

4762

4863 Just { value, length } ->

4964 let

@@ -51,10 +66,18 @@ bit b (BitWriter { running, collected }) =

5166 Bitwise.or (Bitwise.shiftLeftBy length b) value

5267 in

5368 if length == 7 then

54− BitWriter { running = Nothing, collected = BE.sequence [ collected, BE.unsignedInt8 newValue ] }

69+ BitWriter

70+ { running = Nothing

71+ , collected = BE.sequence [ collected, BE.unsignedInt8 newValue ]

72+ , offset = newOffset

73+ }

5574

5675 else

57− BitWriter { running = Just { value = newValue, length = length + 1 }, collected = collected }

76+ BitWriter

77+ { running = Just { value = newValue, length = length + 1 }

78+ , collected = collected

79+ , offset = newOffset

80+ }

5881

5982

6083

src/Urbit.elm+78−27

@@ -1,10 +1,17 @@

1−module Urbit exposing (Noun(..), cue, jam, mat, rub)

1+module Urbit exposing

2+ ( Noun(..)

3+ , cue

4+ , jam

5+ , mat

6+ , rub

7+ )

39import BitParser as BP exposing (BitParser)

410import BitWriter as BW exposing (BitWriter)

511import Bitwise

612import Bytes exposing (Bytes)

713import Bytes.Extra as Bytes

14+import Dict exposing (Dict)

815import List.Extra as List

916

1017

@@ -13,8 +20,22 @@ type Noun

1320 | Atom Bytes

1421

1522

16−jam : Noun -> BitWriter -> BitWriter

17−jam noun writer =

23+type alias Atom =

24+ Bytes

25+

26+

27+jam : Noun -> Bytes

28+jam n =

29+ BW.run (jamWriter n BW.empty)

30+

31+

32+

33+-- Does not use references because it is complex to implement in Elm and would probably lead

34+-- to poor performance

35+

36+

37+jamWriter : Noun -> BitWriter -> BitWriter

38+jamWriter noun writer =

1839 case noun of

1940 Atom atom ->

2041 writer

@@ -25,37 +46,67 @@ jam noun writer =

2546 writer

2647 |> BW.bit 1

2748 |> BW.bit 0

28− |> jam a

29− |> jam b

49+ |> jamWriter a

50+ |> jamWriter b

3051

3152

32−cue : BitParser Noun

53+cue : Bytes -> Maybe Noun

3354cue =

34− BP.bit

35− |> BP.andThen

36− (\isAtom ->

37− if isAtom == 0 then

38− rub |> BP.map Atom

55+ BP.run (cueParser Dict.empty) >> Maybe.map Tuple.second

3956

40− else

41− BP.bit

42− |> BP.andThen

43− (\isRef ->

44− if isRef == 0 then

45− cue

46− |> BP.andThen

47− (\a ->

48− cue

57+

58+cueParser : Dict Int Noun -> BitParser ( Dict Int Noun, Noun )

59+cueParser refs =

60+ BP.getOffset

61+ |> BP.andThen

62+ (\offset ->

63+ BP.bit

64+ |> BP.andThen

65+ (\isAtom ->

66+ if isAtom == 0 then

67+ rub |> BP.map (\a -> ( Dict.insert offset (Atom a) refs, Atom a ))

68+

69+ else

70+ BP.bit

71+ |> BP.andThen

72+ (\isRef ->

73+ if isRef == 0 then

74+ cueParser refs

4975 |> BP.andThen

50− (\b ->

51− Cell ( a, b )

52− |> BP.succeed

76+ (\( refs_, a ) ->

77+ cueParser refs_

78+ |> BP.andThen

79+ (\( refs__, b ) ->

80+ let

81+ c =

82+ Cell ( a, b )

83+ in

84+ ( Dict.insert offset c refs__, c )

85+ |> BP.succeed

86+ )

5387 )

54− )

5588

56− else

57− BP.fail

58− )

89+ else

90+ rub

91+ |> BP.andThen

92+ (\ref ->

93+ case

94+ Dict.get

95+ (Bytes.toByteValues ref

96+ |> List.foldr

97+ (\b acc -> Bitwise.shiftLeftBy 8 acc |> Bitwise.or b)

98+ 0

99+ )

100+ refs

101+ of

102+ Just n ->

103+ BP.succeed ( refs, n )

104+

105+ _ ->

106+ BP.fail

107+ )

108+ )

109+ )

59110 )

60111

61112

tests/Test/Urbit.elm+40−1

@@ -23,8 +23,47 @@ tests =

2323 , fuzz (noun ())

2424 "jam <-> cue"

2525 (\n ->

26− maybeNounEq (Just n) (BitWriter.run (jam n BitWriter.empty) |> BitParser.run cue)

26+ maybeNounEq (Just n) (jam n |> cue)

2727 )

28+ , describe "cue"

29+ [ test "[1 2]"

30+ (\() ->

31+ maybeNounEq

32+ (cue (Bytes.fromByteValues [ 0x31, 0x12 ]))

33+ (Cell ( Atom (Bytes.fromByteValues [ 1 ]), Atom (Bytes.fromByteValues [ 2 ]) ) |> Just)

34+ )

35+ , test "[1 1]"

36+ (\() ->

37+ maybeNounEq

38+ (cue (Bytes.fromByteValues [ 0x31, 0x03 ]))

39+ (Cell ( Atom (Bytes.fromByteValues [ 1 ]), Atom (Bytes.fromByteValues [ 1 ]) ) |> Just)

40+ )

41+ , test "[[1 1] [1 1]]"

42+ (\() ->

43+ maybeNounEq

44+ (cue (Bytes.fromByteValues [ 0xC5, 0x3C, 0x09 ]))

45+ (let

46+ oneOne =

47+ Cell

48+ ( Atom (Bytes.fromByteValues [ 1 ])

49+ , Atom (Bytes.fromByteValues [ 1 ])

50+ )

51+ in

52+ Cell ( oneOne, oneOne ) |> Just

53+ )

54+ )

55+ , test "[0x1234.5678 0x1234.5678]"

56+ (\() ->

57+ maybeNounEq

58+ (cue (Bytes.fromByteValues [ 0x01, 0x1B, 0xCF, 0x8A, 0x46, 0x4E, 0x02 ]))

59+ (let

60+ bigNum =

61+ Atom (Bytes.fromByteValues [ 0x78, 0x56, 0x34, 0x12 ])

62+ in

63+ Cell ( bigNum, bigNum ) |> Just

64+ )

65+ )

66+ ]

2867 ]

2968

3069