mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2025-12-12 12:26:29 +00:00
Code Issues Projects Releases Wiki Activity

Convert the POSIX binding to use the standard library's bitmap module for

Browse Source 
Estimated hours taken: 1
Branches: main

Convert the POSIX binding to use the standard library's bitmap module for
storing byte-oriented data rather than defining a separate module for doing
so.  (The standard library's facilities for dealing with such data are much
more extensive than what they were when the binding was originally written.)

extras/posix/posix.read.m:
extras/posix/posix.write.m:
	Use bitmaps in place of the text/0 type.

extras/posix/text.m:
extras/posix/text_header.h:
	Delete these modules; they are no longer needed.

extras/posix/Mmakefile:
	Don't install the extra header.

extras/posix/hello.m:
extras/posix/samples/mdprof_cgid.m:
	Conform to the above change.
This commit is contained in:
Julien Fischer
2008-09-02 09:45:55 +00:00
parent 211a542aa3
commit a93d6c70d0
7 changed files with 43 additions and 284 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
extras/posix/Mmakefile
View File

@@ -15,7 +15,7 @@ MGNUCFLAGS = --no-ansi
# This library has some parts that are implemented in C
# rather than in Mercury. The following lines ensure that
# the .h and .o files for those parts get included in the library.
ADDITIONAL_HDRS = posix_workarounds.h text_header.h
ADDITIONAL_HDRS = posix_workarounds.h
MLOBJS = posix_workarounds.$O
MLPICOBJS = posix_workarounds.$(EXT_FOR_PIC_OBJECTS)

23
extras/posix/hello.m
View File

@@ -11,8 +11,10 @@
:- import_module posix.
:- import_module posix.open.
:- import_module posix.write.
:- import_module text.
:- import_module bitmap.
:- import_module char.
:- import_module int.
:- import_module list.
:- import_module string.
@@ -22,7 +24,7 @@ main(!IO) :-
Res0 = ok(Fd),
Str = "hello world.\n",
length(Str, Len),
write(Fd, Len, text(Str), Res1, !IO),
write(Fd, Len, string_to_bitmap(Str), Res1, !IO),
(
Res1 = ok(NWritten),
( NWritten \= Len ->
@@ -41,3 +43,20 @@ main(!IO) :-
io.write(Err, !IO),
io.nl(!IO)
).
:- func string_to_bitmap(string::in) = (bitmap::bitmap_uo) is det.
string_to_bitmap(String) = Bitmap :-
NumBytes = string.length(String),
Bitmap0 = bitmap.new(NumBytes * bits_per_byte),
string.to_char_list(String, Chars),
char_list_to_bitmap(Chars, 0, Bitmap0, Bitmap).
:- pred char_list_to_bitmap(list(char)::in, int::in,
bitmap::bitmap_di, bitmap::bitmap_uo) is det.
char_list_to_bitmap([], _, !Bitmap).
char_list_to_bitmap([C | Cs], Index, !Bitmap) :-
char.to_int(C, I),
!:Bitmap = !.Bitmap ^ byte(Index) := I,
char_list_to_bitmap(Cs, Index + 1, !Bitmap).

24
extras/posix/posix.read.m
View File

@@ -14,10 +14,10 @@
:- module posix.read.
:- interface.
:- import_module text.
:- import_module bitmap.
:- pred read(fd::in, int::in, posix.result(int)::out,
text::di, text::uo, io::di, io::uo) is det.
bitmap::bitmap_di, bitmap::bitmap_uo, io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -28,13 +28,12 @@
:- pragma foreign_decl("C", "
#include <unistd.h>
#include ""text_header.h""
").
%-----------------------------------------------------------------------------%
read(Fd, ToRead, Result, !Text, !IO) :-
read0(Fd, ToRead, Read, !Text, !IO),
read(Fd, ToRead, Result, !Bitmap, !IO) :-
read0(Fd, ToRead, Read, !Bitmap, !IO),
( Read < 0 ->
errno(Err, !IO),
Result = error(Err)
@@ -42,21 +41,18 @@ read(Fd, ToRead, Result, !Text, !IO) :-
Result = ok(Read)
).
:- pred read0(fd::in, int::in, int::out, text::di, text::uo,
io::di, io::uo) is det.
:- pred read0(fd::in, int::in, int::out,
bitmap::bitmap_di, bitmap::bitmap_uo, io::di, io::uo) is det.
:- pragma foreign_proc("C",
read0(Fd::in, ToRead::in, Read::out, Text0::di, Text::uo, IO0::di, IO::uo),
read0(Fd::in, ToRead::in, Read::out, Bitmap0::bitmap_di, Bitmap::bitmap_uo,
IO0::di, IO::uo),
[promise_pure, will_not_call_mercury, thread_safe, tabled_for_io],
"
ME_Text *txtptr;
txtptr = (ME_Text *) Text0;
do {
Read = read(Fd, txtptr->data, ToRead);
Read = read(Fd, Bitmap0->elements, ToRead);
} while (Read == -1 && MR_is_eintr(errno));
Text = Text0;
Bitmap = Bitmap0;
IO = IO0;
").

14
extras/posix/posix.write.m
View File

@@ -14,11 +14,11 @@
:- module posix.write.
:- interface.
:- import_module text.
:- import_module bitmap.
%-----------------------------------------------------------------------------%
:- pred write(fd::in, int::in, text::in, posix.result(int)::out,
:- pred write(fd::in, int::in, bitmap::in, posix.result(int)::out,
io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
@@ -29,7 +29,6 @@
:- pragma foreign_decl("C", "
#include <unistd.h>
#include ""text_header.h""
").
%-----------------------------------------------------------------------------%
@@ -43,16 +42,13 @@ write(Fd, ToWrite, Text, Result, !IO) :-
Result = ok(Res)
).
:- pred write0(fd::in, int::in, text::in, int::out, io::di, io::uo) is det.
:- pred write0(fd::in, int::in, bitmap::in, int::out, io::di, io::uo) is det.
:- pragma foreign_proc("C",
write0(Fd::in, ToWrite::in, Text::in, Res::out, IO0::di, IO::uo),
write0(Fd::in, ToWrite::in, Bitmap::in, Res::out, IO0::di, IO::uo),
[promise_pure, will_not_call_mercury, thread_safe, tabled_for_io],
"
ME_Text *txtptr;
txtptr = (ME_Text *) Text;
do {
Res = write(Fd, txtptr->data, ToWrite);
Res = write(Fd, Bitmap->elements, ToWrite);
} while (Res == -1 && MR_is_eintr(errno));
IO = IO0;
").

17
extras/posix/samples/mdprof_cgid.m
View File

@@ -25,6 +25,7 @@
:- implementation.
:- import_module bitmap.
:- import_module char.
:- import_module getopt.
:- import_module int.
@@ -38,7 +39,6 @@
:- import_module posix.open.
:- import_module posix.select.
:- import_module posix.socket.
:- import_module text.
%-----------------------------------------------------------------------------%
%
@@ -206,7 +206,7 @@ wait_input_fd(Fd @ fd(MaxFd), Result, !IO) :-
handle_conn(Data, ConnFd, !IO) :-
TextSize = 1024,
text.create(TextSize, 0, Text0),
Text0 = bitmap.new(TextSize * bits_per_int),
read(ConnFd, TextSize, ReadResult, Text0, Text, !IO),
(
ReadResult = ok(Length),
@@ -305,21 +305,21 @@ write_http_response(StatusCode, Message, !IO) :-
%-----------------------------------------------------------------------------%
% first_line(Text, TextLen) = String
% Return the first line from the Text object as a string,
% Return the first line from the bitmap object as a string,
% i.e. everything up to the first CR or NL character.
%
:- func first_line(text, int) = string.
:- func first_line(bitmap, int) = string.
first_line(Text, TextLen) =
string.from_char_list(first_line_2(Text, 0, TextLen)).
:- func first_line_2(text, int, int) = list(char).
:- func first_line_2(bitmap, int, int) = list(char).
first_line_2(Text, Index, TextLen) = RevChars :-
( if Index >= TextLen then
RevChars = []
else
Char = text_char(Text, Index),
Char = char.det_from_int(Text ^ byte(Index)),
( if is_newline(Char) then
RevChars = []
else
@@ -327,11 +327,6 @@ first_line_2(Text, Index, TextLen) = RevChars :-
)
).
:- func text_char(text, int) = char.
text_char(Text, Index) = char.det_from_int(Int) :-
text.index(Text, Index, Int).
:- pred is_newline(char::in) is semidet.
is_newline('\n').

238
extras/posix/text.m
View File

@@ -1,238 +0,0 @@
%------------------------------------------------------------------------------%
% Copyright (C) 1999-2000 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
%------------------------------------------------------------------------------%
%
% module: text.m
% main author: conway@cs.mu.oz.au
%
% This module provides a byte-array module intended for storing text and
% binary byte-oriented data.
%
%------------------------------------------------------------------------------%
:- module text.
:- interface.
:- type text.
:- type byte == int. % Using low 8 bits only.
% text(String) = Text
% takes a Mercury string `String' and returns the same data in the
% text representation `Text'.
:- func text(string) = text.
:- mode (text(in) = uo) is det.
% create(Size, Init, Text)
% creates a text object of `Size' bytes each initialized to `Init',
% and binds it to `Text'.
:- pred create(int, byte, text).
:- mode create(in, in, uo) is det.
% index(Text, Index, Value)
% binds `Value' to the `Index'th element of `Text'. Indices are
% 0 offset (Like C arrays). index/3 aborts if `Index' is out of
% range.
:- pred index(text, int, byte).
:- mode index(ui, in, out) is det.
:- mode index(in, in, out) is det.
% update(Index, Value, OldText, NewText)
% destroys `OldText' and binds `NewText' to a text object that
% is the same as `OldText' except that the byte at `Index' is
% replaced with `Value'. update/4 aborts if `Index' is out of
% range.
:- pred update(int, byte, text, text).
:- mode update(in, in, di, uo) is det.
% length(Text, Length)
% binds `Length' to the number of bytes in the text object `Text'.
:- pred length(text, int).
:- mode length(ui, out) is det.
:- mode length(in, out) is det.
% unique(SharedText) = UniqueText
% performs an unsafe uniqueness cast on `SharedText' to make
% `UniqueText'. This is useful if you're storing text objects
% inside other data structures, but is of course risky since
% it is unchecked by the compiler. USE AT OWN RISK!
:- func unique(text) = text.
:- mode unique(in) = uo is det.
% split(WholeText, Index, FirstPart, SecondPart)
% splits `WholeText' into two parts: `FirstPart' and `SecondPart'
% on the boundary `Index'.
:- pred split(text, int, text, text).
:- mode split(di, in, uo, uo) is det.
% combine(FirstPart, SecondPart, WholeText)
% combines two text objects that were created by splitting `WholeText'.
% combine/3 aborts if `FirstPart' and `SecondPart' did not come from
% the same text object (in an operational sense, not a declarative
% sense - this is a bug, or at least a missing feature).
:- pred combine(text, text, text).
:- mode combine(di, di, uo) is det.
%------------------------------------------------------------------------------%
:- implementation.
:- import_module char, int, list, std_util, string.
:- type text
---> text(c_pointer).
:- pragma c_header_code("
#include ""text_header.h""
/*
** ME_words(amt) returns the number of words necessary to
** to store `amt' bytes.
*/
#define ME_words(x) (((x) + sizeof(MR_Word) - 1) / sizeof(MR_Word))
").
%------------------------------------------------------------------------------%
text(Str) = Text :-
length(Str, Len),
create(Len, 0, Text0),
string__to_char_list(Str, Chars),
text_2(Chars, 0, Text0, Text).
:- pred text_2(list(char), int, text, text).
:- mode text_2(in, in, di, uo) is det.
text_2([], _, Text, Text).
text_2([C|Cs], N, Text0, Text) :-
char__to_int(C, I),
update(N, I, Text0, Text1),
text_2(Cs, N+1, Text1, Text).
%------------------------------------------------------------------------------%
:- pragma c_code(create(Len::in, Val::in, Txt::uo),
[will_not_call_mercury, thread_safe], "{
ME_Text *txtptr;
MR_Word tmp;
int i;
MR_incr_hp(Txt, ME_words(sizeof(ME_Text)));
MR_incr_hp_atomic(tmp, ME_words(Len));
txtptr = (ME_Text *) Txt;
txtptr->len = Len;
txtptr->data = (char *) tmp;
for (i=0; i < Len; i++)
txtptr->data[i] = Val;
}").
%------------------------------------------------------------------------------%
:- pragma c_code(index(Txt::ui, Ind::in, Val::out),
[will_not_call_mercury, thread_safe], "{
ME_Text *txtptr;
txtptr = (ME_Text *) Txt;
if (Ind < 0 || Ind >= txtptr->len) {
MR_fatal_error(""text:index : index out of range"");
}
Val = txtptr->data[Ind];
}").
:- pragma c_code(index(Txt::in, Ind::in, Val::out),
[will_not_call_mercury, thread_safe], "{
ME_Text *txtptr;
txtptr = (ME_Text *) Txt;
if (Ind < 0 || Ind >= txtptr->len) {
MR_fatal_error(""text:index : index out of range"");
}
Val = txtptr->data[Ind];
}").
%------------------------------------------------------------------------------%
:- pragma c_code(update(Ind::in, Val::in, Txt0::di, Txt::uo),
[will_not_call_mercury, thread_safe], "{
ME_Text *txtptr;
txtptr = (ME_Text *) Txt0;
if (Ind < 0 || Ind >= txtptr->len) {
MR_fatal_error(""text:index : index out of range"");
}
txtptr->data[Ind] = Val;
Txt = Txt0;
}").
%------------------------------------------------------------------------------%
:- pragma c_code(length(Txt::ui, Len::out),
[will_not_call_mercury, thread_safe], "{
ME_Text *txtptr;
txtptr = (ME_Text *) Txt;
Len = txtptr->len;
}").
:- pragma c_code(length(Txt::in, Len::out),
[will_not_call_mercury, thread_safe], "{
ME_Text *txtptr;
txtptr = (ME_Text *) Txt;
Len = txtptr->len;
}").
%------------------------------------------------------------------------------%
:- pragma c_code(unique(A::in) = (B::uo),
[will_not_call_mercury, thread_safe], "{
B = A;
}").
%------------------------------------------------------------------------------%
:- pragma c_code(split(Text0::di, Where::in, Text1::uo, Text2::uo),
[will_not_call_mercury, thread_safe], "{
ME_Text *txtptr1, *txtptr2;
txtptr1 = (ME_Text *) Text0;
if (Where < 0 || Where >= txtptr1->len) {
MR_fatal_error(""text:split : index out of range"");
}
Text1 = Text0;
MR_incr_hp(Text2, ME_words(sizeof(ME_Text)));
txtptr2 = (ME_Text *) Text2;
txtptr2->len = txtptr1->len - Where;
txtptr2->data = txtptr1->data + Where;
txtptr1->len = Where;
}").
%------------------------------------------------------------------------------%
:- pragma c_code(combine(Text0::di, Text1::di, Text::uo),
[will_not_call_mercury, thread_safe], "{
ME_Text *txtptr1, *txtptr2;
txtptr1 = (ME_Text *) Text0;
txtptr2 = (ME_Text *) Text1;
if (txtptr1->data + txtptr1->len != txtptr2->data) {
MR_fatal_error(""text:combine : not adjacent text"");
}
txtptr1->len = txtptr1->len + txtptr2->len;
Text = Text0;
}").

9
extras/posix/text_header.h
View File

@@ -1,9 +0,0 @@
#ifndef ME_TEXT_HEADER_H
#define ME_TEXT_HEADER_H
typedef struct {
unsigned len;
char *data;
} ME_Text;
#endif