Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Some array additions/fixes #3146

Merged
merged 1 commit into from Jun 22, 2022
Merged

Some array additions/fixes #3146

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
12 changes: 12 additions & 0 deletions parser-typechecker/src/Unison/Builtin.hs
View file
Open in desktop
Expand Up @@ -528,6 +528,10 @@ builtinsSrc =
reft g a --> Type.effect1 () g a,
B "Ref.write" . forall2 "a" "g" $ \a g ->
reft g a --> a --> Type.effect1 () g unit,
B "MutableArray.size" . forall2 "g" "a" $ \g a -> marrayt g a --> nat,
B "MutableByteArray.size" . forall1 "g" $ \g -> mbytearrayt g --> nat,
B "ImmutableArray.size" . forall1 "a" $ \a -> iarrayt a --> nat,
B "ImmutableByteArray.size" $ ibytearrayt --> nat,
B "MutableArray.copyTo!" . forall2 "g" "a" $ \g a ->
marrayt g a --> nat --> marrayt g a --> nat --> nat
--> Type.effect () [g, DD.exceptionType ()] unit,
Expand All @@ -540,8 +544,12 @@ builtinsSrc =
mbytearrayt g --> nat --> Type.effect () [g, DD.exceptionType ()] nat,
B "MutableByteArray.read16be" . forall1 "g" $ \g ->
mbytearrayt g --> nat --> Type.effect () [g, DD.exceptionType ()] nat,
B "MutableByteArray.read24be" . forall1 "g" $ \g ->
mbytearrayt g --> nat --> Type.effect () [g, DD.exceptionType ()] nat,
B "MutableByteArray.read32be" . forall1 "g" $ \g ->
mbytearrayt g --> nat --> Type.effect () [g, DD.exceptionType ()] nat,
B "MutableByteArray.read40be" . forall1 "g" $ \g ->
mbytearrayt g --> nat --> Type.effect () [g, DD.exceptionType ()] nat,
B "MutableByteArray.read64be" . forall1 "g" $ \g ->
mbytearrayt g --> nat --> Type.effect () [g, DD.exceptionType ()] nat,
B "MutableArray.write" . forall2 "g" "a" $ \g a ->
Expand All @@ -566,8 +574,12 @@ builtinsSrc =
ibytearrayt --> nat --> Type.effect1 () (DD.exceptionType ()) nat,
B "ImmutableByteArray.read16be" $
ibytearrayt --> nat --> Type.effect1 () (DD.exceptionType ()) nat,
B "ImmutableByteArray.read24be" $
ibytearrayt --> nat --> Type.effect1 () (DD.exceptionType ()) nat,
B "ImmutableByteArray.read32be" $
ibytearrayt --> nat --> Type.effect1 () (DD.exceptionType ()) nat,
B "ImmutableByteArray.read40be" $
ibytearrayt --> nat --> Type.effect1 () (DD.exceptionType ()) nat,
B "ImmutableByteArray.read64be" $
ibytearrayt --> nat --> Type.effect1 () (DD.exceptionType ()) nat,
B "MutableArray.freeze!" . forall2 "g" "a" $ \g a ->
Expand Down
105 changes: 93 additions & 12 deletions parser-typechecker/src/Unison/Runtime/Builtin.hs
View file
Open in desktop
Expand Up @@ -2443,6 +2443,15 @@ declareForeigns = do
(fromIntegral soff)
(fromIntegral l)

declareForeign Untracked "ImmutableArray.size" boxToNat . mkForeign $
pure . fromIntegral @Int @Word64 . PA.sizeofArray @Closure
declareForeign Untracked "MutableArray.size" boxToNat . mkForeign $
pure . fromIntegral @Int @Word64 . PA.sizeofMutableArray @PA.RealWorld @Closure
declareForeign Untracked "ImmutableByteArray.size" boxToNat . mkForeign $
pure . fromIntegral @Int @Word64 . PA.sizeofByteArray
declareForeign Untracked "MutableByteArray.size" boxToNat . mkForeign $
pure . fromIntegral @Int @Word64 . PA.sizeofMutableByteArray @PA.RealWorld

declareForeign Tracked "ImmutableByteArray.copyTo!" boxNatBoxNatNatToExnUnit
. mkForeign
$ \(dst, doff, src, soff, l) ->
Expand All @@ -2469,9 +2478,15 @@ declareForeigns = do
declareForeign Tracked "MutableByteArray.read16be" boxNatToExnNat
. mkForeign
$ checkedRead16 "MutableByteArray.read16be"
declareForeign Tracked "MutableByteArray.read24be" boxNatToExnNat
. mkForeign
$ checkedRead24 "MutableByteArray.read24be"
declareForeign Tracked "MutableByteArray.read32be" boxNatToExnNat
. mkForeign
$ checkedRead32 "MutableByteArray.read32be"
declareForeign Tracked "MutableByteArray.read40be" boxNatToExnNat
. mkForeign
$ checkedRead40 "MutableByteArray.read40be"
declareForeign Tracked "MutableByteArray.read64be" boxNatToExnNat
. mkForeign
$ checkedRead64 "MutableByteArray.read64be"
Expand Down Expand Up @@ -2501,9 +2516,15 @@ declareForeigns = do
declareForeign Untracked "ImmutableByteArray.read16be" boxNatToExnNat
. mkForeign
$ checkedIndex16 "ImmutableByteArray.read16be"
declareForeign Untracked "ImmutableByteArray.read24be" boxNatToExnNat
. mkForeign
$ checkedIndex24 "ImmutableByteArray.read24be"
declareForeign Untracked "ImmutableByteArray.read32be" boxNatToExnNat
. mkForeign
$ checkedIndex32 "ImmutableByteArray.read32be"
declareForeign Untracked "ImmutableByteArray.read40be" boxNatToExnNat
. mkForeign
$ checkedIndex40 "ImmutableByteArray.read40be"
declareForeign Untracked "ImmutableByteArray.read64be" boxNatToExnNat
. mkForeign
$ checkedIndex64 "ImmutableByteArray.read64be"
Expand Down Expand Up @@ -2605,9 +2626,19 @@ checkedRead8 name (arr, i) =
checkedRead16 :: Text -> (PA.MutableByteArray RW, Word64) -> IO (Either Failure Word64)
checkedRead16 name (arr, i) =
checkBoundsPrim name (PA.sizeofMutableByteArray arr) i 2 $
(mk16)
mk16
<$> PA.readByteArray @Word8 arr j
<*> PA.readByteArray @Word8 arr (j + 1)
where
j = fromIntegral i

checkedRead24 :: Text -> (PA.MutableByteArray RW, Word64) -> IO (Either Failure Word64)
checkedRead24 name (arr, i) =
checkBoundsPrim name (PA.sizeofMutableByteArray arr) i 3 $
mk24
<$> PA.readByteArray @Word8 arr j
<*> PA.readByteArray @Word8 arr (j + 1)
<*> PA.readByteArray @Word8 arr (j + 2)
where
j = fromIntegral i

Expand All @@ -2622,6 +2653,18 @@ checkedRead32 name (arr, i) =
where
j = fromIntegral i

checkedRead40 :: Text -> (PA.MutableByteArray RW, Word64) -> IO (Either Failure Word64)
checkedRead40 name (arr, i) =
checkBoundsPrim name (PA.sizeofMutableByteArray arr) i 6 $
mk40
<$> PA.readByteArray @Word8 arr j
<*> PA.readByteArray @Word8 arr (j + 1)
<*> PA.readByteArray @Word8 arr (j + 2)
<*> PA.readByteArray @Word8 arr (j + 3)
<*> PA.readByteArray @Word8 arr (j + 4)
where
j = fromIntegral i

checkedRead64 :: Text -> (PA.MutableByteArray RW, Word64) -> IO (Either Failure Word64)
checkedRead64 name (arr, i) =
checkBoundsPrim name (PA.sizeofMutableByteArray arr) i 8 $
Expand All @@ -2638,26 +2681,42 @@ checkedRead64 name (arr, i) =
j = fromIntegral i

mk16 :: Word8 -> Word8 -> Either Failure Word64
mk16 b0 b1 = Right $ (fromIntegral $ b0 `shiftL` 8) .|. (fromIntegral b1)
mk16 b0 b1 = Right $ (fromIntegral b0 `shiftL` 8) .|. (fromIntegral b1)

mk24 :: Word8 -> Word8 -> Word8 -> Either Failure Word64
mk24 b0 b1 b2 =
Right $
(fromIntegral b0 `shiftL` 16)
.|. (fromIntegral b1 `shiftL` 8)
.|. (fromIntegral b2)

mk32 :: Word8 -> Word8 -> Word8 -> Word8 -> Either Failure Word64
mk32 b0 b1 b2 b3 =
Right $
(fromIntegral $ b0 `shiftL` 24)
.|. (fromIntegral $ b1 `shiftL` 16)
.|. (fromIntegral $ b2 `shiftL` 8)
(fromIntegral b0 `shiftL` 24)
.|. (fromIntegral b1 `shiftL` 16)
.|. (fromIntegral b2 `shiftL` 8)
.|. (fromIntegral b3)

mk40 :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Either Failure Word64
mk40 b0 b1 b2 b3 b4 =
Right $
(fromIntegral b0 `shiftL` 32)
.|. (fromIntegral b1 `shiftL` 24)
.|. (fromIntegral b2 `shiftL` 16)
.|. (fromIntegral b3 `shiftL` 8)
.|. (fromIntegral b4)

mk64 :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Either Failure Word64
mk64 b0 b1 b2 b3 b4 b5 b6 b7 =
Right $
(fromIntegral $ b0 `shiftL` 56)
.|. (fromIntegral $ b1 `shiftL` 48)
.|. (fromIntegral $ b2 `shiftL` 40)
.|. (fromIntegral $ b3 `shiftL` 32)
.|. (fromIntegral $ b4 `shiftL` 24)
.|. (fromIntegral $ b5 `shiftL` 16)
.|. (fromIntegral $ b6 `shiftL` 8)
(fromIntegral b0 `shiftL` 56)
.|. (fromIntegral b1 `shiftL` 48)
.|. (fromIntegral b2 `shiftL` 40)
.|. (fromIntegral b3 `shiftL` 32)
.|. (fromIntegral b4 `shiftL` 24)
.|. (fromIntegral b5 `shiftL` 16)
.|. (fromIntegral b6 `shiftL` 8)
.|. (fromIntegral b7)

checkedWrite8 :: Text -> (PA.MutableByteArray RW, Word64, Word64) -> IO (Either Failure ())
Expand Down Expand Up @@ -2717,6 +2776,16 @@ checkedIndex16 name (arr, i) =
let j = fromIntegral i
in mk16 (PA.indexByteArray arr j) (PA.indexByteArray arr (j + 1))

-- index 32 big-endian
checkedIndex24 :: Text -> (PA.ByteArray, Word64) -> IO (Either Failure Word64)
checkedIndex24 name (arr, i) =
checkBoundsPrim name (PA.sizeofByteArray arr) i 3 . pure $
let j = fromIntegral i
in mk24
(PA.indexByteArray arr j)
(PA.indexByteArray arr (j + 1))
(PA.indexByteArray arr (j + 2))

-- index 32 big-endian
checkedIndex32 :: Text -> (PA.ByteArray, Word64) -> IO (Either Failure Word64)
checkedIndex32 name (arr, i) =
Expand All @@ -2728,6 +2797,18 @@ checkedIndex32 name (arr, i) =
(PA.indexByteArray arr (j + 2))
(PA.indexByteArray arr (j + 3))

-- index 40 big-endian
checkedIndex40 :: Text -> (PA.ByteArray, Word64) -> IO (Either Failure Word64)
checkedIndex40 name (arr, i) =
checkBoundsPrim name (PA.sizeofByteArray arr) i 5 . pure $
let j = fromIntegral i
in mk40
(PA.indexByteArray arr j)
(PA.indexByteArray arr (j + 1))
(PA.indexByteArray arr (j + 2))
(PA.indexByteArray arr (j + 3))
(PA.indexByteArray arr (j + 4))

-- index 64 big-endian
checkedIndex64 :: Text -> (PA.ByteArray, Word64) -> IO (Either Failure Word64)
checkedIndex64 name (arr, i) =
Expand Down