## win32-io.pkg
# Hooks to Win32 IO system.
package Win32_IO
: Win32_IO
{
package W32G = win32_general
type hndl = W32G::hndl
type word = W32G::word
type offset = file_position::Int
fun cf name = W32G::cfun "win32_io" name
my setFilePointer' : (hndl * word * word) -> word =
cf "set_file_pointer"
cc = W32G::getConst "FILE"
my FILE_BEGIN: word = cc "BEGIN"
my FILE_CURRENT: word = cc "CURRENT"
my FILE_END: word = cc "END"
my readVec' : hndl * Int -> vector_of_one_byte_unts::Vector = cf "read_vector"
my readArr' : (hndl * rw_vector_of_one_byte_unts::Rw_Vector * Int * Int)
-> Int = cf "read_rw_vector"
my readVecTxt' : hndl * Int -> vector_of_chars::Vector = cf "read_vec_txt"
my readArrTxt' : (hndl * rw_vector_of_chars::Rw_Vector * Int * Int)
-> Int = cf "read_arr_txt"
fun vecF f (h, i) =
if i < 0 then raise exception INDEX_OUT_OF_BOUNDS else f (h, i)
fun bufF (f, baseF) (h, sl) = let
my (buf, i, size) = baseF sl
in
f (h, buf, size, i)
end
readVec = vecF readVec'
readArr = bufF (readArr', rw_vector_slice_of_one_byte_unts::base)
readVecTxt = vecF readVecTxt'
readArrTxt = bufF (readArrTxt', rw_vector_slice_of_chars::base)
my close: hndl -> Void = cf "close"
cc = W32G::getConst "GENERIC"
my GENERIC_READ: word = cc "READ"
my GENERIC_WRITE: word = cc "WRITE"
cc = W32G::getConst "FILE_SHARE"
my FILE_SHARE_READ: word = cc "READ"
my FILE_SHARE_WRITE: word = cc "WRITE"
cc = W32G::getConst "FILE_FLAG"
my FILE_FLAG_WRITE_THROUGH: word = cc "WRITE_THROUGH"
my FILE_FLAG_OVERLAPPED: word = cc "OVERLAPPED"
my FILE_FLAG_NO_BUFFERING: word = cc "NO_BUFFERING"
my FILE_FLAG_RANDOM_ACCESS: word = cc "RANDOM_ACCESS"
my FILE_FLAG_SEQUENTIAL_SCAN: word = cc "SEQUENTIAL_SCAN"
my FILE_FLAG_DELETE_ON_CLOSE: word = cc "DELETE_ON_CLOSE"
my FILE_FLAG_BACKUP_SEMANTICS: word = cc "BACKUP_SEMANTICS"
my FILE_FLAG_POSIX_SEMANTICS: word = cc "POSIX_SEMANTICS"
cc = W32G::getConst "FILE_MODE"
my CREATE_NEW: word = cc "CREATE_NEW"
my CREATE_ALWAYS: word = cc "CREATE_ALWAYS"
my OPEN_EXISTING: word = cc "OPEN_EXISTING"
my OPEN_ALWAYS: word = cc "OPEN_ALWAYS"
my TRUNCATE_EXISTING: word = cc "TRUNCATE_EXISTING"
# name, access, share, mode, attributes
my createFile' : (String * word * word * word * word) -> hndl =
cf "create_file"
fun createFile { name: String,
access: word, share: word, mode: word, attributes: word } =
createFile'(name, access, share, mode, attributes)
my writeVec' : (hndl * vector_of_one_byte_unts::Vector * Int * Int) -> Int =
cf "write_vector"
my writeArr' : (hndl * rw_vector_of_one_byte_unts::Rw_Vector * Int * Int) -> Int =
cf "write_rw_vector"
my writeVecTxt' : (hndl * vector_of_chars::Vector * Int * Int) -> Int =
cf "write_vec_txt"
my writeArrTxt' : (hndl * rw_vector_of_chars::Rw_Vector * Int * Int) -> Int =
cf "write_arr_txt"
writeVec = bufF (writeVec', vector_slice_of_one_byte_unts::base)
writeArr = bufF (writeArr', rw_vector_slice_of_one_byte_unts::base)
writeVecTxt = bufF (writeVecTxt', vector_slice_of_chars::base)
writeArrTxt = bufF (writeArrTxt', rw_vector_slice_of_chars::base)
cc = W32G::getConst "STD_HANDLE"
my STD_INPUT_HANDLE: word = cc "INPUT"
my STD_OUTPUT_HANDLE: word = cc "OUTPUT"
my STD_ERROR_HANDLE: word = cc "ERROR"
my getStdHandle: win32_general::word -> hndl = cf "get_std_handle"
}