ilyakooo0/airlock
1
0
Fork 0
mirror of https://github.com/ilyakooo0/airlock.git synced 2024-10-05 14:27:58 +03:00
Code Issues Packages Projects Releases Wiki Activity

Finished cue

Browse Source
This commit is contained in:
iko 2023-05-29 09:03:48 +03:00
parent ace1fc22ff
commit 38a906d7a7
Signed by untrusted user: iko
GPG Key ID: 82C257048D1026F2
4 changed files with 165 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
src/BitParser.elm
View File

@ -5,6 +5,7 @@ module BitParser exposing
, bits
, bitsToInt
, fail
, getOffset
, intBits
, map
, rawBits
@ -20,11 +21,12 @@ import Bytes.Encode as BE
run : BitParser a -> Bytes -> Maybe a
run (BitParser f) bytes =
BD.decode (f { running = Nothing }) bytes |> Maybe.map Tuple.second
BD.decode (f { running = Nothing, offset = 0 }) bytes |> Maybe.map Tuple.second
type alias BitParserState =
{ running : Maybe { byte : Int, length : Int }
, offset : Int
}
@ -32,16 +34,27 @@ type BitParser a
= BitParser (BitParserState -> BD.Decoder ( BitParserState, a ))
getOffset : BitParser Int
getOffset =
BitParser (\state -> BD.succeed ( state, state.offset ))
bit : BitParser Int
bit =
BitParser
(\{ running } ->
(\{ running, offset } ->
let
newOffset =
offset + 1
in
case running of
Nothing ->
BD.unsignedInt8
|> BD.map
(\i ->
( { running = Just { byte = Bitwise.shiftRightBy 1 i, length = 7 } }
( { running = Just { byte = Bitwise.shiftRightBy 1 i, length = 7 }
, offset = newOffset
}
, Bitwise.and 1 i
)
)
@ -49,10 +62,12 @@ bit =
Just { byte, length } ->
BD.succeed
(if length == 1 then
( { running = Nothing }, byte )
( { running = Nothing, offset = newOffset }, byte )
else
( { running = Just { byte = Bitwise.shiftRightBy 1 byte, length = length - 1 } }
( { running = Just { byte = Bitwise.shiftRightBy 1 byte, length = length - 1 }
, offset = newOffset
}
, Bitwise.and 1 byte
)
)

33
src/BitWriter.elm
View File

@ -3,6 +3,7 @@ module BitWriter exposing
, bit
, bits
, empty
, getOffset
, run
)
@ -13,7 +14,7 @@ import Bytes.Encode as BE
empty : BitWriter
empty =
BitWriter { running = Nothing, collected = BE.sequence [] }
BitWriter { running = Nothing, collected = BE.sequence [], offset = 0 }
run : BitWriter -> Bytes
@ -33,17 +34,31 @@ type BitWriter
{ value : Int
, length : Int
}
, offset : Int
, collected : BE.Encoder
}
getOffset : BitWriter -> Int
getOffset (BitWriter { offset }) =
offset
{-| If the given int is longer than 1 bit the behaviour is undefined
-}
bit : Int -> BitWriter -> BitWriter
bit b (BitWriter { running, collected }) =
bit b (BitWriter { running, collected, offset }) =
let
newOffset =
offset + 1
in
case running of
Nothing ->
BitWriter { running = Just { value = b, length = 1 }, collected = collected }
BitWriter
{ running = Just { value = b, length = 1 }
, collected = collected
, offset = newOffset
}
Just { value, length } ->
let
@ -51,10 +66,18 @@ bit b (BitWriter { running, collected }) =
Bitwise.or (Bitwise.shiftLeftBy length b) value
in
if length == 7 then
BitWriter { running = Nothing, collected = BE.sequence [ collected, BE.unsignedInt8 newValue ] }
BitWriter
{ running = Nothing
, collected = BE.sequence [ collected, BE.unsignedInt8 newValue ]
, offset = newOffset
}
else
BitWriter { running = Just { value = newValue, length = length + 1 }, collected = collected }
BitWriter
{ running = Just { value = newValue, length = length + 1 }
, collected = collected
, offset = newOffset
}

103
src/Urbit.elm
View File

@ -1,10 +1,17 @@
module Urbit exposing (Noun(..), cue, jam, mat, rub)
module Urbit exposing
( Noun(..)
, cue
, jam
, mat
, rub
)
import BitParser as BP exposing (BitParser)
import BitWriter as BW exposing (BitWriter)
import Bitwise
import Bytes exposing (Bytes)
import Bytes.Extra as Bytes
import Dict exposing (Dict)
import List.Extra as List
@ -13,8 +20,22 @@ type Noun
| Atom Bytes
jam : Noun -> BitWriter -> BitWriter
jam noun writer =
type alias Atom =
Bytes
jam : Noun -> Bytes
jam n =
BW.run (jamWriter n BW.empty)
-- Does not use references because it is complex to implement in Elm and would probably lead
-- to poor performance
jamWriter : Noun -> BitWriter -> BitWriter
jamWriter noun writer =
case noun of
Atom atom ->
writer
@ -25,37 +46,67 @@ jam noun writer =
writer
|> BW.bit 1
|> BW.bit 0
|> jam a
|> jam b
|> jamWriter a
|> jamWriter b
cue : BitParser Noun
cue : Bytes -> Maybe Noun
cue =
BP.bit
BP.run (cueParser Dict.empty) >> Maybe.map Tuple.second
cueParser : Dict Int Noun -> BitParser ( Dict Int Noun, Noun )
cueParser refs =
BP.getOffset
|> BP.andThen
(\isAtom ->
if isAtom == 0 then
rub |> BP.map Atom
(\offset ->
BP.bit
|> BP.andThen
(\isAtom ->
if isAtom == 0 then
rub |> BP.map (\a -> ( Dict.insert offset (Atom a) refs, Atom a ))
else
BP.bit
|> BP.andThen
(\isRef ->
if isRef == 0 then
cue
|> BP.andThen
(\a ->
cue
else
BP.bit
|> BP.andThen
(\isRef ->
if isRef == 0 then
cueParser refs
|> BP.andThen
(\b ->
Cell ( a, b )
|> BP.succeed
(\( refs_, a ) ->
cueParser refs_
|> BP.andThen
(\( refs__, b ) ->
let
c =
Cell ( a, b )
in
( Dict.insert offset c refs__, c )
|> BP.succeed
)
)
)
else
BP.fail
)
else
rub
|> BP.andThen
(\ref ->
case
Dict.get
(Bytes.toByteValues ref
|> List.foldr
(\b acc -> Bitwise.shiftLeftBy 8 acc |> Bitwise.or b)
0
)
refs
of
Just n ->
BP.succeed ( refs, n )
_ ->
BP.fail
)
)
)
)

41
tests/Test/Urbit.elm
View File

@ -23,8 +23,47 @@ tests =
, fuzz (noun ())
"jam <-> cue"
(\n ->
maybeNounEq (Just n) (BitWriter.run (jam n BitWriter.empty) |> BitParser.run cue)
maybeNounEq (Just n) (jam n |> cue)
)
, describe "cue"
[ test "[1 2]"
(\() ->
maybeNounEq
(cue (Bytes.fromByteValues [ 0x31, 0x12 ]))
(Cell ( Atom (Bytes.fromByteValues [ 1 ]), Atom (Bytes.fromByteValues [ 2 ]) ) |> Just)
)
, test "[1 1]"
(\() ->
maybeNounEq
(cue (Bytes.fromByteValues [ 0x31, 0x03 ]))
(Cell ( Atom (Bytes.fromByteValues [ 1 ]), Atom (Bytes.fromByteValues [ 1 ]) ) |> Just)
)
, test "[[1 1] [1 1]]"
(\() ->
maybeNounEq
(cue (Bytes.fromByteValues [ 0xC5, 0x3C, 0x09 ]))
(let
oneOne =
Cell
( Atom (Bytes.fromByteValues [ 1 ])
, Atom (Bytes.fromByteValues [ 1 ])
)
in
Cell ( oneOne, oneOne ) |> Just
)
)
, test "[0x1234.5678 0x1234.5678]"
(\() ->
maybeNounEq
(cue (Bytes.fromByteValues [ 0x01, 0x1B, 0xCF, 0x8A, 0x46, 0x4E, 0x02 ]))
(let
bigNum =
Atom (Bytes.fromByteValues [ 0x78, 0x56, 0x34, 0x12 ])
in
Cell ( bigNum, bigNum ) |> Just
)
)
]
]