Bufferfile implementation in Mercury

bufferfile.m

:- module bufferfile.
%==============================================================================%
:- interface.
%==============================================================================%

:- use_module io.
:- use_module maybe.

:- type buffer.
:- type file.

:- pred bufferfile(string::in, maybe.maybe(buffer)::out, io.io::di, io.io::uo) is det.

:- pred open(string::in, maybe.maybe(file)::uo, io.io::di, io.io::uo) is det.
:- func size(file) = int.
:- pred map(file::in, int::in, buffer::uo) is det.

%==============================================================================%
:- implementation.
%==============================================================================%

:- func create_yes_file(file) = (maybe.maybe(file)).
:- mode create_yes_file(di) = (uo) is det.
:- mode create_yes_file(in) = (out) is det.
create_yes_file(File) = maybe.yes(File).
:- pragma foreign_export("C", create_yes_file(di) = uo, "MerBufferFile_YesFile").

:- func create_no_file = (maybe.maybe(file)::uo) is det.
create_no_file = maybe.no.
:- pragma foreign_export("C", create_no_file = uo, "MerBufferFile_NoFile").

:- pragma foreign_decl("C",
    "
#ifdef _WIN32

#include <Windows.h>
typedef HANDLE MerBufferFile_FileDeref;
#define BUFFERFILE_FILE_OK(F) (F)

#else

#include <stdlib.h>
#include <unistd.h>
#include <fcntl.h>
#include <sys/stat.h>
#include <sys/types.h>
#include <sys/mman.h>
#include <assert.h>
typedef int MerBufferFile_FileDeref;
#define BUFFERFILE_FILE_OK(F) (F>=0)

#endif

typedef MerBufferFile_FileDeref *MerBufferFile_File;

struct MerBufferFile_Buffer {
    void *data;
    unsigned long len;
    MerBufferFile_File file;
};

#ifdef _WIN32

void MerBufferFile_BufferFinalizer(void *data, void *unused){
    (void)unused;
    UnmapViewOfFile(((struct MerBufferFile_Buffer*)data)->data);
}

void MerBufferFile_FileFinalizer(void *data, void *unused){
    CloseHandle(*(MerBufferFile_File)data);
}

#else

void MerBufferFile_BufferFinalizer(void *data, void *unused){
    (void)unused;
    const struct MerBufferFile_Buffer *const buffer =
        (struct MerBufferFile_Buffer *)data;
    munmap(buffer->data, buffer->len);
}

void MerBufferFile_FileFinalizer(void *data, void *unused){
    close(*(MerBufferFile_File)data);
}
#endif
    ").

:- pragma foreign_type("C", buffer, "struct MerBufferFile_Buffer*").
:- pragma foreign_type("C", file, "MerBufferFile_File").

:- pragma foreign_proc("C", open(Path::in, MaybeFile::uo, IO0::di, IO1::uo),
    [will_not_call_mercury, promise_pure, will_not_throw_exception,
     thread_safe, does_not_affect_liveness, tabled_for_io],
    "
    const MerBufferFile_FileDeref file =
#ifdef _WIN32
        CreateFile(Path, GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING,
            FILE_ATTRIBUTE_NORMAL, NULL);
#else
        open(Path, O_RDONLY);
#endif

    if(BUFFERFILE_FILE_OK(file)){
        MerBufferFile_File out =
            MR_GC_malloc_atomic(sizeof(MerBufferFile_File));
        out[0] = file;
        MR_GC_register_finalizer(out, MerBufferFile_FileFinalizer, NULL);
        MaybeFile = MerBufferFile_YesFile(out);
    }
    else{
        MaybeFile = MerBufferFile_NoFile();
    }
    IO1 = IO0;
    ").

:- pragma foreign_proc("C", size(File::in) = (Size::out),
    [will_not_call_mercury, promise_pure, will_not_throw_exception,
     thread_safe, does_not_affect_liveness],
    "
#ifdef _WIN32
        Size = GetFileSize(*File, NULL);
#else
    {
        struct stat lstat;
        fstat(*File, &lstat);
        Size = lstat.st_size;
    }
#endif
    ").

:- pragma foreign_proc("C", map(File::in, Len::in, Buffer::uo),
    [will_not_call_mercury, promise_pure, will_not_throw_exception,
     thread_safe, does_not_affect_liveness, tabled_for_io],
    "
        struct MerBufferFile_Buffer* const buffer = MR_GC_malloc(sizeof(struct MerBufferFile_Buffer));
        buffer->len = Len;
#ifdef _WIN32
        {
            HANDLE mmiofile = CreateFileMapping(*File, NULL, PAGE_READONLY, 0, 0, NULL);
            buffer->data = MapViewOfFile(mmiofile, FILE_MAP_READ, 0, 0, Len);
            CloseHandle(mmiofile);
        }
#else
        buffer->data = mmap(NULL, Len, PROT_READ, MAP_SHARED, *File, 0);
#endif
        MR_GC_register_finalizer(buffer, MerBufferFile_BufferFinalizer, NULL);
        Buffer = buffer;
    ").

bufferfile(Name, MaybeOutput, !IO) :-
    open(Name, MaybeFile, !IO),
    (
        MaybeFile = maybe.yes(File),
        MaybeOutput = maybe.yes(Buffer),
        map(File, size(File), Buffer)
    ;
        MaybeFile = maybe.no,
        MaybeOutput = maybe.no
    ).