mirror of
https://github.com/idris-lang/Idris2.git
synced 2024-12-19 01:01:59 +03:00
c54c1a6e97
We should really get these automatically, but until we do, add the flags. Chez seems to spot these anyway, but again it makes the generated code easier to look at, and it removes some needless abstraction over interfaces at runtime.
331 lines
12 KiB
Idris
331 lines
12 KiB
Idris
module Data.Buffer
|
|
|
|
import System.Directory
|
|
import System.File
|
|
|
|
import Data.List
|
|
|
|
-- Reading and writing binary buffers. Note that this primitives are unsafe,
|
|
-- in that they don't check that buffer locations are within bounds.
|
|
-- We really need a safe wrapper!
|
|
-- They are used in the Idris compiler itself for reading/writing checked
|
|
-- files.
|
|
|
|
-- This is known to the compiler, so maybe ought to be moved to Builtin
|
|
export
|
|
data Buffer : Type where [external]
|
|
|
|
%foreign "scheme:blodwen-buffer-size"
|
|
"node:lambda:b => BigInt(b.length)"
|
|
prim__bufferSize : Buffer -> Int
|
|
|
|
export %inline
|
|
rawSize : HasIO io => Buffer -> io Int
|
|
rawSize buf = pure (prim__bufferSize buf)
|
|
|
|
%foreign "scheme:blodwen-new-buffer"
|
|
"node:lambda:s=>Buffer.alloc(Number(s))"
|
|
prim__newBuffer : Int -> PrimIO Buffer
|
|
|
|
export
|
|
newBuffer : HasIO io => Int -> io (Maybe Buffer)
|
|
newBuffer size
|
|
= do buf <- primIO (prim__newBuffer size)
|
|
pure $ Just buf
|
|
-- if prim__nullAnyPtr buf /= 0
|
|
-- then pure Nothing
|
|
-- else pure $ Just $ MkBuffer buf size 0
|
|
|
|
-- might be needed if we do this in C...
|
|
export
|
|
freeBuffer : HasIO io => Buffer -> io ()
|
|
freeBuffer buf = pure ()
|
|
|
|
%foreign "scheme:blodwen-buffer-setbyte"
|
|
"node:lambda:(buf,offset,value)=>buf.writeUInt8(Number(value), Number(offset))"
|
|
prim__setByte : Buffer -> Int -> Int -> PrimIO ()
|
|
|
|
%foreign "scheme:blodwen-buffer-setbyte"
|
|
"node:lambda:(buf,offset,value)=>buf.writeUInt8(Number(value), Number(offset))"
|
|
prim__setBits8 : Buffer -> Int -> Bits8 -> PrimIO ()
|
|
|
|
-- Assumes val is in the range 0-255
|
|
export %inline
|
|
setByte : HasIO io => Buffer -> (loc : Int) -> (val : Int) -> io ()
|
|
setByte buf loc val
|
|
= primIO (prim__setByte buf loc val)
|
|
|
|
export %inline
|
|
setBits8 : HasIO io => Buffer -> (loc : Int) -> (val : Bits8) -> io ()
|
|
setBits8 buf loc val
|
|
= primIO (prim__setBits8 buf loc val)
|
|
|
|
%foreign "scheme:blodwen-buffer-getbyte"
|
|
"node:lambda:(buf,offset)=>BigInt(buf.readUInt8(Number(offset)))"
|
|
prim__getByte : Buffer -> Int -> PrimIO Int
|
|
|
|
%foreign "scheme:blodwen-buffer-getbyte"
|
|
"node:lambda:(buf,offset)=>BigInt(buf.readUInt8(Number(offset)))"
|
|
prim__getBits8 : Buffer -> Int -> PrimIO Bits8
|
|
|
|
export %inline
|
|
getByte : HasIO io => Buffer -> (loc : Int) -> io Int
|
|
getByte buf loc
|
|
= primIO (prim__getByte buf loc)
|
|
|
|
export %inline
|
|
getBits8 : HasIO io => Buffer -> (loc : Int) -> io Bits8
|
|
getBits8 buf loc
|
|
= primIO (prim__getBits8 buf loc)
|
|
|
|
%foreign "scheme:blodwen-buffer-setbits16"
|
|
"node:lambda:(buf,offset,value)=>buf.writeUInt16LE(Number(value), Number(offset))"
|
|
prim__setBits16 : Buffer -> Int -> Bits16 -> PrimIO ()
|
|
|
|
export %inline
|
|
setBits16 : HasIO io => Buffer -> (loc : Int) -> (val : Bits16) -> io ()
|
|
setBits16 buf loc val
|
|
= primIO (prim__setBits16 buf loc val)
|
|
|
|
%foreign "scheme:blodwen-buffer-getbits16"
|
|
"node:lambda:(buf,offset)=>BigInt(buf.readUInt16LE(Number(offset)))"
|
|
prim__getBits16 : Buffer -> Int -> PrimIO Bits16
|
|
|
|
export %inline
|
|
getBits16 : HasIO io => Buffer -> (loc : Int) -> io Bits16
|
|
getBits16 buf loc
|
|
= primIO (prim__getBits16 buf loc)
|
|
|
|
%foreign "scheme:blodwen-buffer-setbits32"
|
|
"node:lambda:(buf,offset,value)=>buf.writeUInt32LE(Number(value), Number(offset))"
|
|
prim__setBits32 : Buffer -> Int -> Bits32 -> PrimIO ()
|
|
|
|
export %inline
|
|
setBits32 : HasIO io => Buffer -> (loc : Int) -> (val : Bits32) -> io ()
|
|
setBits32 buf loc val
|
|
= primIO (prim__setBits32 buf loc val)
|
|
|
|
%foreign "scheme:blodwen-buffer-getbits32"
|
|
"node:lambda:(buf,offset)=>BigInt(buf.readUInt32LE(Number(offset)))"
|
|
prim__getBits32 : Buffer -> Int -> PrimIO Bits32
|
|
|
|
export %inline
|
|
getBits32 : HasIO io => Buffer -> (loc : Int) -> io Bits32
|
|
getBits32 buf loc
|
|
= primIO (prim__getBits32 buf loc)
|
|
|
|
%foreign "scheme:blodwen-buffer-setbits64"
|
|
prim__setBits64 : Buffer -> Int -> Bits64 -> PrimIO ()
|
|
|
|
export %inline
|
|
setBits64 : HasIO io => Buffer -> (loc : Int) -> (val : Bits64) -> io ()
|
|
setBits64 buf loc val
|
|
= primIO (prim__setBits64 buf loc val)
|
|
|
|
%foreign "scheme:blodwen-buffer-getbits64"
|
|
prim__getBits64 : Buffer -> Int -> PrimIO Bits64
|
|
|
|
export %inline
|
|
getBits64 : HasIO io => Buffer -> (loc : Int) -> io Bits64
|
|
getBits64 buf loc
|
|
= primIO (prim__getBits64 buf loc)
|
|
|
|
%foreign "scheme:blodwen-buffer-setint32"
|
|
"node:lambda:(buf,offset,value)=>buf.writeInt32LE(Number(value), Number(offset))"
|
|
prim__setInt32 : Buffer -> Int -> Int -> PrimIO ()
|
|
|
|
export %inline
|
|
setInt32 : HasIO io => Buffer -> (loc : Int) -> (val : Int) -> io ()
|
|
setInt32 buf loc val
|
|
= primIO (prim__setInt32 buf loc val)
|
|
|
|
%foreign "scheme:blodwen-buffer-getint32"
|
|
"node:lambda:(buf,offset)=>BigInt(buf.readInt32LE(Number(offset)))"
|
|
prim__getInt32 : Buffer -> Int -> PrimIO Int
|
|
|
|
export %inline
|
|
getInt32 : HasIO io => Buffer -> (loc : Int) -> io Int
|
|
getInt32 buf loc
|
|
= primIO (prim__getInt32 buf loc)
|
|
|
|
%foreign "scheme:blodwen-buffer-setint"
|
|
"node:lambda:(buf,offset,value)=>buf.writeInt64(Number(value), Number(offset))"
|
|
prim__setInt : Buffer -> Int -> Int -> PrimIO ()
|
|
|
|
export %inline
|
|
setInt : HasIO io => Buffer -> (loc : Int) -> (val : Int) -> io ()
|
|
setInt buf loc val
|
|
= primIO (prim__setInt buf loc val)
|
|
|
|
%foreign "scheme:blodwen-buffer-getint"
|
|
"node:lambda:(buf,offset)=>BigInt(buf.readInt64(Number(offset)))"
|
|
prim__getInt : Buffer -> Int -> PrimIO Int
|
|
|
|
export %inline
|
|
getInt : HasIO io => Buffer -> (loc : Int) -> io Int
|
|
getInt buf loc
|
|
= primIO (prim__getInt buf loc)
|
|
|
|
%foreign "scheme:blodwen-buffer-setdouble"
|
|
"node:lambda:(buf,offset,value)=>buf.writeDoubleLE(value, Number(offset))"
|
|
prim__setDouble : Buffer -> Int -> Double -> PrimIO ()
|
|
|
|
export %inline
|
|
setDouble : HasIO io => Buffer -> (loc : Int) -> (val : Double) -> io ()
|
|
setDouble buf loc val
|
|
= primIO (prim__setDouble buf loc val)
|
|
|
|
%foreign "scheme:blodwen-buffer-getdouble"
|
|
"node:lambda:(buf,offset)=>buf.readDoubleLE(Number(offset))"
|
|
prim__getDouble : Buffer -> Int -> PrimIO Double
|
|
|
|
export %inline
|
|
getDouble : HasIO io => Buffer -> (loc : Int) -> io Double
|
|
getDouble buf loc
|
|
= primIO (prim__getDouble buf loc)
|
|
|
|
-- Get the length of a string in bytes, rather than characters
|
|
export
|
|
%foreign "C:strlen,libc 6"
|
|
stringByteLength : String -> Int
|
|
|
|
%foreign "scheme:blodwen-buffer-setstring"
|
|
"node:lambda:(buf,offset,value)=>buf.write(value, Number(offset),buf.length - Number(offset), 'utf-8')"
|
|
prim__setString : Buffer -> Int -> String -> PrimIO ()
|
|
|
|
export %inline
|
|
setString : HasIO io => Buffer -> (loc : Int) -> (val : String) -> io ()
|
|
setString buf loc val
|
|
= primIO (prim__setString buf loc val)
|
|
|
|
%foreign "scheme:blodwen-buffer-getstring"
|
|
"node:lambda:(buf,offset,len)=>buf.slice(Number(offset), Number(offset+len)).toString('utf-8')"
|
|
prim__getString : Buffer -> Int -> Int -> PrimIO String
|
|
|
|
export %inline
|
|
getString : HasIO io => Buffer -> (loc : Int) -> (len : Int) -> io String
|
|
getString buf loc len
|
|
= primIO (prim__getString buf loc len)
|
|
|
|
export
|
|
bufferData : HasIO io => Buffer -> io (List Int)
|
|
bufferData buf
|
|
= do len <- rawSize buf
|
|
unpackTo [] len
|
|
where
|
|
unpackTo : List Int -> Int -> io (List Int)
|
|
unpackTo acc 0 = pure acc
|
|
unpackTo acc loc
|
|
= do val <- getByte buf (loc - 1)
|
|
unpackTo (val :: acc) (loc - 1)
|
|
|
|
|
|
%foreign "scheme:blodwen-buffer-copydata"
|
|
"node:lambda:(b1,o1,length,b2,o2)=>b1.copy(b2,Number(o2), Number(o1), Number(o1+length))"
|
|
prim__copyData : Buffer -> Int -> Int -> Buffer -> Int -> PrimIO ()
|
|
|
|
export
|
|
copyData : HasIO io => (src : Buffer) -> (start, len : Int) ->
|
|
(dest : Buffer) -> (loc : Int) -> io ()
|
|
copyData src start len dest loc
|
|
= primIO (prim__copyData src start len dest loc)
|
|
|
|
%foreign "C:idris2_readBufferData,libidris2_support"
|
|
"node:lambda:(f,b,l,m) => BigInt(require('fs').readSync(f.fd,b,Number(l), Number(m)))"
|
|
prim__readBufferData : FilePtr -> Buffer -> Int -> Int -> PrimIO Int
|
|
|
|
%foreign "C:idris2_writeBufferData,libidris2_support"
|
|
"node:lambda:(f,b,l,m) => BigInt(require('fs').writeSync(f.fd,b,Number(l), Number(m)))"
|
|
prim__writeBufferData : FilePtr -> Buffer -> Int -> Int -> PrimIO Int
|
|
|
|
export
|
|
readBufferData : HasIO io => File -> Buffer ->
|
|
(loc : Int) -> -- position in buffer to start adding
|
|
(maxbytes : Int) -> -- maximums size to read, which must not
|
|
-- exceed buffer length
|
|
io (Either FileError ())
|
|
readBufferData (FHandle h) buf loc max
|
|
= do read <- primIO (prim__readBufferData h buf loc max)
|
|
if read >= 0
|
|
then pure (Right ())
|
|
else pure (Left FileReadError)
|
|
|
|
export
|
|
writeBufferData : HasIO io => File -> Buffer ->
|
|
(loc : Int) -> -- position in buffer to write from
|
|
(maxbytes : Int) -> -- maximums size to write, which must not
|
|
-- exceed buffer length
|
|
io (Either FileError ())
|
|
writeBufferData (FHandle h) buf loc max
|
|
= do written <- primIO (prim__writeBufferData h buf loc max)
|
|
if written >= 0
|
|
then pure (Right ())
|
|
else pure (Left FileWriteError)
|
|
|
|
export
|
|
writeBufferToFile : HasIO io => String -> Buffer -> Int -> io (Either FileError ())
|
|
writeBufferToFile fn buf max
|
|
= do Right f <- openFile fn WriteTruncate
|
|
| Left err => pure (Left err)
|
|
Right ok <- writeBufferData f buf 0 max
|
|
| Left err => pure (Left err)
|
|
closeFile f
|
|
pure (Right ok)
|
|
|
|
export
|
|
createBufferFromFile : HasIO io => String -> io (Either FileError Buffer)
|
|
createBufferFromFile fn
|
|
= do Right f <- openFile fn Read
|
|
| Left err => pure (Left err)
|
|
Right size <- fileSize f
|
|
| Left err => pure (Left err)
|
|
Just buf <- newBuffer size
|
|
| Nothing => pure (Left FileReadError)
|
|
Right ok <- readBufferData f buf 0 size
|
|
| Left err => pure (Left err)
|
|
closeFile f
|
|
pure (Right buf)
|
|
|
|
export
|
|
resizeBuffer : HasIO io => Buffer -> Int -> io (Maybe Buffer)
|
|
resizeBuffer old newsize
|
|
= do Just buf <- newBuffer newsize
|
|
| Nothing => pure Nothing
|
|
-- If the new buffer is smaller than the old one, just copy what
|
|
-- fits
|
|
oldsize <- rawSize old
|
|
let len = if newsize < oldsize then newsize else oldsize
|
|
copyData old 0 len buf 0
|
|
freeBuffer old
|
|
pure (Just buf)
|
|
|
|
||| Create a buffer containing the concatenated content from a
|
|
||| list of buffers.
|
|
export
|
|
concatBuffers : HasIO io => List Buffer -> io (Maybe Buffer)
|
|
concatBuffers xs
|
|
= do let sizes = map prim__bufferSize xs
|
|
let (totalSize, revCumulative) = foldl scanSize (0,[]) sizes
|
|
let cumulative = reverse revCumulative
|
|
Just buf <- newBuffer totalSize
|
|
| Nothing => pure Nothing
|
|
traverse_ (\(b, size, watermark) => copyData b 0 size buf watermark) (zip3 xs sizes cumulative)
|
|
pure (Just buf)
|
|
where
|
|
scanSize : (Int, List Int) -> Int -> (Int, List Int)
|
|
scanSize (s, cs) x = (s+x, s::cs)
|
|
|
|
||| Split a buffer into two at a position.
|
|
export
|
|
splitBuffer : HasIO io => Buffer -> Int -> io (Maybe (Buffer, Buffer))
|
|
splitBuffer buf pos = do size <- rawSize buf
|
|
if pos > 0 && pos < size
|
|
then do Just first <- newBuffer pos
|
|
| Nothing => pure Nothing
|
|
Just second <- newBuffer (size - pos)
|
|
| Nothing => pure Nothing
|
|
copyData buf 0 pos first 0
|
|
copyData buf pos (size-pos) second 0
|
|
pure $ Just (first, second)
|
|
else pure Nothing
|