[m-rev.] [PATCH 02/11] mercury_cairo: Fix create_surface predicates to not call back into Mercury.
Peter Wang
novalazy at gmail.com
Fri Sep 4 12:00:50 AEST 2015
The create_surface_2 foreign procs for each surface type were declared
`will_not_call_mercury' but actually called exported Mercury predicates
to build trivial data structures.
extras/graphics/mercury_cairo/cairo.image.m:
extras/graphics/mercury_cairo/cairo.pdf.m:
extras/graphics/mercury_cairo/cairo.ps.m:
extras/graphics/mercury_cairo/cairo.svg.m:
Write create_surface_2 predicates without calling Mercury
predicates.
---
extras/graphics/mercury_cairo/cairo.image.m | 46 ++++++--------------
extras/graphics/mercury_cairo/cairo.pdf.m | 65 ++++++++++------------------
extras/graphics/mercury_cairo/cairo.ps.m | 65 ++++++++++------------------
extras/graphics/mercury_cairo/cairo.svg.m | 67 ++++++++++-------------------
4 files changed, 80 insertions(+), 163 deletions(-)
diff --git a/extras/graphics/mercury_cairo/cairo.image.m b/extras/graphics/mercury_cairo/cairo.image.m
index 65ee79f..291faad 100644
--- a/extras/graphics/mercury_cairo/cairo.image.m
+++ b/extras/graphics/mercury_cairo/cairo.image.m
@@ -68,53 +68,33 @@
% Image surface creation
%
-:- type maybe_image_surface
- ---> image_surface_ok(image_surface)
- ; image_surface_error(cairo.status).
-
-:- pragma foreign_export("C", make_image_surface_ok(in) = out,
- "MCAIRO_image_surface_ok").
-:- func make_image_surface_ok(image_surface) = maybe_image_surface.
-
-make_image_surface_ok(Surface) = image_surface_ok(Surface).
-
-:- pragma foreign_export("C", make_image_surface_error(in) = out,
- "MCAIRO_image_surface_error").
-:- func make_image_surface_error(cairo.status) = maybe_image_surface.
-
-make_image_surface_error(Status) = image_surface_error(Status).
-
create_surface(Format, Height, Width, Surface, !IO) :-
- create_surface_2(Format, Height, Width, MaybeSurface, !IO),
- (
- MaybeSurface = image_surface_ok(Surface)
+ create_surface_2(Format, Height, Width, Status, Surface, !IO),
+ ( Status = status_success ->
+ true
;
- MaybeSurface = image_surface_error(ErrorStatus),
- throw(cairo.error("image.create_surface/6", ErrorStatus))
+ throw(cairo.error("image.create_surface/6", Status))
).
-:- pred create_surface_2(format::in, int::in, int::in,
- maybe_image_surface::out, io::di, io::uo) is det.
+:- pred create_surface_2(format::in, int::in, int::in, cairo.status::out,
+ image_surface::out, io::di, io::uo) is det.
:- pragma foreign_proc("C",
- create_surface_2(Fmt::in, H::in, W::in, MaybeSurface::out,
+ create_surface_2(Fmt::in, H::in, W::in, Status::out, Surface::out,
_IO0::di, _IO::uo),
[promise_pure, will_not_call_mercury],
"
- MCAIRO_surface *surface;
cairo_surface_t *raw_surface;
- cairo_status_t status;
raw_surface = cairo_image_surface_create((cairo_format_t)Fmt,
(int)H, (int)W);
- status = cairo_surface_status(raw_surface);
+ Status = cairo_surface_status(raw_surface);
- switch (status) {
+ switch (Status) {
case CAIRO_STATUS_SUCCESS:
- surface = MR_GC_NEW(MCAIRO_surface);
- surface->mcairo_raw_surface = raw_surface;
- MR_GC_register_finalizer(surface, MCAIRO_finalize_surface, 0);
- MaybeSurface = MCAIRO_image_surface_ok(surface);
+ Surface = MR_GC_NEW(MCAIRO_surface);
+ Surface->mcairo_raw_surface = raw_surface;
+ MR_GC_register_finalizer(Surface, MCAIRO_finalize_surface, 0);
break;
case CAIRO_STATUS_NULL_POINTER:
@@ -123,7 +103,7 @@ create_surface(Format, Height, Width, Surface, !IO) :-
case CAIRO_STATUS_INVALID_CONTENT:
case CAIRO_STATUS_INVALID_FORMAT:
case CAIRO_STATUS_INVALID_VISUAL:
- MaybeSurface = MCAIRO_image_surface_error(status);
+ Surface = NULL;
break;
default:
diff --git a/extras/graphics/mercury_cairo/cairo.pdf.m b/extras/graphics/mercury_cairo/cairo.pdf.m
index b32b3c4..75e0917 100644
--- a/extras/graphics/mercury_cairo/cairo.pdf.m
+++ b/extras/graphics/mercury_cairo/cairo.pdf.m
@@ -82,64 +82,41 @@
% PDF surface creation
%
-:- type maybe_pdf_surface
- ---> pdf_surface_ok(pdf_surface)
- ; pdf_surface_error(cairo.status)
- ; pdf_surface_unsupported.
-
-:- pragma foreign_export("C", make_pdf_surface_ok(in) = out,
- "MCAIRO_pdf_surface_ok").
-:- func make_pdf_surface_ok(pdf_surface) = maybe_pdf_surface.
-
-make_pdf_surface_ok(Surface) = pdf_surface_ok(Surface).
-
-:- pragma foreign_export("C", make_pdf_surface_error(in) = out,
- "MCAIRO_pdf_surface_error").
-:- func make_pdf_surface_error(cairo.status) = maybe_pdf_surface.
-
-make_pdf_surface_error(Status) = pdf_surface_error(Status).
-
-:- pragma foreign_export("C", make_pdf_surface_unsupported = out,
- "MCAIRO_pdf_surface_unsupported").
-:- func make_pdf_surface_unsupported = maybe_pdf_surface.
-
-make_pdf_surface_unsupported = pdf_surface_unsupported.
-
create_surface(FileName, Height, Width, Surface, !IO) :-
- create_surface_2(FileName, Height, Width, MaybeSurface, !IO),
+ create_surface_2(FileName, Height, Width, Supported, Status, Surface, !IO),
(
- MaybeSurface = pdf_surface_ok(Surface)
- ;
- MaybeSurface = pdf_surface_error(ErrorStatus),
- throw(cairo.error("pdf.create_surface/6", ErrorStatus))
+ Supported = yes,
+ ( Status = status_success ->
+ true
+ ;
+ throw(cairo.error("svg.create_surface/6", Status))
+ )
;
- MaybeSurface = pdf_surface_unsupported,
+ Supported = no,
throw(cairo.unsupported_surface_error("PDF"))
).
-:- pred create_surface_2(string::in,
- float::in, float::in, maybe_pdf_surface::out, io::di, io::uo) is det.
+:- pred create_surface_2(string::in, float::in, float::in,
+ bool::out, cairo.status::out, pdf_surface::out, io::di, io::uo) is det.
:- pragma foreign_proc("C",
- create_surface_2(FileName::in, H::in, W::in, MaybeSurface::out,
- _IO0::di, _IO::uo),
+ create_surface_2(FileName::in, H::in, W::in,
+ Supported::out, Status::out, Surface::out, _IO0::di, _IO::uo),
[promise_pure, will_not_call_mercury, tabled_for_io],
"
#if defined(CAIRO_HAS_PDF_SURFACE)
- MCAIRO_surface *surface;
cairo_surface_t *raw_surface;
- cairo_status_t status;
+ Supported = MR_YES;
raw_surface = cairo_pdf_surface_create(FileName, H, W);
- status = cairo_surface_status(raw_surface);
+ Status = cairo_surface_status(raw_surface);
- switch (status) {
+ switch (Status) {
case CAIRO_STATUS_SUCCESS:
- surface = MR_GC_NEW(MCAIRO_surface);
- surface->mcairo_raw_surface = raw_surface;
- MR_GC_register_finalizer(surface, MCAIRO_finalize_surface, 0);
- MaybeSurface = MCAIRO_pdf_surface_ok(surface);
+ Surface = MR_GC_NEW(MCAIRO_surface);
+ Surface->mcairo_raw_surface = raw_surface;
+ MR_GC_register_finalizer(Surface, MCAIRO_finalize_surface, 0);
break;
case CAIRO_STATUS_NULL_POINTER:
@@ -148,7 +125,7 @@ create_surface(FileName, Height, Width, Surface, !IO) :-
case CAIRO_STATUS_INVALID_CONTENT:
case CAIRO_STATUS_INVALID_FORMAT:
case CAIRO_STATUS_INVALID_VISUAL:
- MaybeSurface = MCAIRO_pdf_surface_error(status);
+ Surface = NULL;
break;
default:
@@ -156,7 +133,9 @@ create_surface(FileName, Height, Width, Surface, !IO) :-
\"unknown PDF surface status\");
}
#else
- MaybeSurface = MCAIRO_pdf_surface_unsupported();
+ Supported = MR_NO;
+ Status = CAIRO_STATUS_SUCCESS;
+ Surface = NULL;
#endif
").
diff --git a/extras/graphics/mercury_cairo/cairo.ps.m b/extras/graphics/mercury_cairo/cairo.ps.m
index f302b1b..5a4fea8 100644
--- a/extras/graphics/mercury_cairo/cairo.ps.m
+++ b/extras/graphics/mercury_cairo/cairo.ps.m
@@ -128,64 +128,41 @@
% PostScript surface creation
%
-:- type maybe_ps_surface
- ---> ps_surface_ok(ps_surface)
- ; ps_surface_error(cairo.status)
- ; ps_surface_unsupported.
-
-:- pragma foreign_export("C", make_ps_surface_ok(in) = out,
- "MCAIRO_ps_surface_ok").
-:- func make_ps_surface_ok(ps_surface) = maybe_ps_surface.
-
-make_ps_surface_ok(Surface) = ps_surface_ok(Surface).
-
-:- pragma foreign_export("C", make_ps_surface_error(in) = out,
- "MCAIRO_ps_surface_error").
-:- func make_ps_surface_error(cairo.status) = maybe_ps_surface.
-
-make_ps_surface_error(Status) = ps_surface_error(Status).
-
-:- pragma foreign_export("C", make_ps_surface_unsupported = out,
- "MCAIRO_ps_surface_unsupported").
-:- func make_ps_surface_unsupported = maybe_ps_surface.
-
-make_ps_surface_unsupported = ps_surface_unsupported.
-
create_surface(FileName, Height, Width, Surface, !IO) :-
- create_surface_2(FileName, Height, Width, MaybeSurface, !IO),
+ create_surface_2(FileName, Height, Width, Supported, Status, Surface, !IO),
(
- MaybeSurface = ps_surface_ok(Surface)
- ;
- MaybeSurface = ps_surface_error(ErrorStatus),
- throw(cairo.error("ps.create_surface/6", ErrorStatus))
+ Supported = yes,
+ ( Status = status_success ->
+ true
+ ;
+ throw(cairo.error("svg.create_surface/6", Status))
+ )
;
- MaybeSurface = ps_surface_unsupported,
+ Supported = no,
throw(cairo.unsupported_surface_error("PostScript"))
).
-:- pred create_surface_2(string::in,
- float::in, float::in, maybe_ps_surface::out, io::di, io::uo) is det.
+:- pred create_surface_2(string::in, float::in, float::in,
+ bool::out, cairo.status::out, ps_surface::out, io::di, io::uo) is det.
:- pragma foreign_proc("C",
- create_surface_2(FileName::in, H::in, W::in, MaybeSurface::out,
- _IO0::di, _IO::uo),
+ create_surface_2(FileName::in, H::in, W::in,
+ Supported::out, Status::out, Surface::out, _IO0::di, _IO::uo),
[promise_pure, will_not_call_mercury, tabled_for_io],
"
#if defined(CAIRO_HAS_PS_SURFACE)
- MCAIRO_surface *surface;
cairo_surface_t *raw_surface;
- cairo_status_t status;
+ Supported = MR_YES;
raw_surface = cairo_ps_surface_create(FileName, H, W);
- status = cairo_surface_status(raw_surface);
+ Status = cairo_surface_status(raw_surface);
- switch (status) {
+ switch (Status) {
case CAIRO_STATUS_SUCCESS:
- surface = MR_GC_NEW(MCAIRO_surface);
- surface->mcairo_raw_surface = raw_surface;
- MR_GC_register_finalizer(surface, MCAIRO_finalize_surface, 0);
- MaybeSurface = MCAIRO_ps_surface_ok(surface);
+ Surface = MR_GC_NEW(MCAIRO_surface);
+ Surface->mcairo_raw_surface = raw_surface;
+ MR_GC_register_finalizer(Surface, MCAIRO_finalize_surface, 0);
break;
case CAIRO_STATUS_NULL_POINTER:
@@ -194,7 +171,7 @@ create_surface(FileName, Height, Width, Surface, !IO) :-
case CAIRO_STATUS_INVALID_CONTENT:
case CAIRO_STATUS_INVALID_FORMAT:
case CAIRO_STATUS_INVALID_VISUAL:
- MaybeSurface = MCAIRO_ps_surface_error(status);
+ Surface = NULL;
break;
default:
@@ -203,7 +180,9 @@ create_surface(FileName, Height, Width, Surface, !IO) :-
}
#else
- MaybeSurface = MCAIRO_ps_surface_unsupported();
+ Supported = MR_NO;
+ Status = CAIRO_STATUS_SUCCESS;
+ Surface = NULL;
#endif
").
diff --git a/extras/graphics/mercury_cairo/cairo.svg.m b/extras/graphics/mercury_cairo/cairo.svg.m
index a115909..bfbfb60 100644
--- a/extras/graphics/mercury_cairo/cairo.svg.m
+++ b/extras/graphics/mercury_cairo/cairo.svg.m
@@ -90,64 +90,41 @@
% SVG surface creation
%
-:- type maybe_svg_surface
- ---> svg_surface_ok(svg_surface)
- ; svg_surface_error(cairo.status)
- ; svg_surface_unsupported.
-
-:- pragma foreign_export("C", make_svg_surface_ok(in) = out,
- "MCAIRO_svg_surface_ok").
-:- func make_svg_surface_ok(svg_surface) = maybe_svg_surface.
-
-make_svg_surface_ok(Surface) = svg_surface_ok(Surface).
-
-:- pragma foreign_export("C", make_svg_surface_error(in) = out,
- "MCAIRO_svg_surface_error").
-:- func make_svg_surface_error(cairo.status) = maybe_svg_surface.
-
-make_svg_surface_error(Status) = svg_surface_error(Status).
-
-:- pragma foreign_export("C", make_svg_surface_unsupported = out,
- "MCAIRO_svg_surface_usupported").
-:- func make_svg_surface_unsupported = maybe_svg_surface.
-
-make_svg_surface_unsupported = svg_surface_unsupported.
-
create_surface(FileName, Height, Width, Surface, !IO) :-
- create_surface_2(FileName, Height, Width, MaybeSurface, !IO),
+ create_surface_2(FileName, Height, Width, Supported, Status, Surface, !IO),
(
- MaybeSurface = svg_surface_ok(Surface)
+ Supported = yes,
+ ( Status = status_success ->
+ true
+ ;
+ throw(cairo.error("svg.create_surface/6", Status))
+ )
;
- MaybeSurface = svg_surface_error(ErrorStatus),
- throw(cairo.error("svg.create_surface/6", ErrorStatus))
- ;
- MaybeSurface = svg_surface_unsupported,
+ Supported = no,
throw(cairo.unsupported_surface_error("SVG"))
- ).
+ ).
-:- pred create_surface_2(string::in, int::in, int::in, maybe_svg_surface::out,
- io::di, io::uo) is det.
+:- pred create_surface_2(string::in, int::in, int::in, bool::out,
+ cairo.status::out, svg_surface::out, io::di, io::uo) is det.
:- pragma foreign_proc("C",
- create_surface_2(FileName::in, H::in, W::in, MaybeSurface::out,
- _IO0::di, _IO::uo),
+ create_surface_2(FileName::in, H::in, W::in,
+ Supported::out, Status::out, Surface::out, _IO0::di, _IO::uo),
[promise_pure, will_not_call_mercury, tabled_for_io],
"
#if defined(CAIRO_HAS_SVG_SURFACE)
- MCAIRO_surface *surface;
cairo_surface_t *raw_surface;
- cairo_status_t status;
+ Supported = MR_YES;
raw_surface = cairo_svg_surface_create(FileName, (int)H, (int)W);
- status = cairo_surface_status(raw_surface);
+ Status = cairo_surface_status(raw_surface);
- switch (status) {
+ switch (Status) {
case CAIRO_STATUS_SUCCESS:
- surface = MR_GC_NEW(MCAIRO_surface);
- surface->mcairo_raw_surface = raw_surface;
- MR_GC_register_finalizer(surface, MCAIRO_finalize_surface, 0);
- MaybeSurface = MCAIRO_svg_surface_ok(surface);
+ Surface = MR_GC_NEW(MCAIRO_surface);
+ Surface->mcairo_raw_surface = raw_surface;
+ MR_GC_register_finalizer(Surface, MCAIRO_finalize_surface, 0);
break;
case CAIRO_STATUS_NULL_POINTER:
@@ -156,7 +133,7 @@ create_surface(FileName, Height, Width, Surface, !IO) :-
case CAIRO_STATUS_INVALID_CONTENT:
case CAIRO_STATUS_INVALID_FORMAT:
case CAIRO_STATUS_INVALID_VISUAL:
- MaybeSurface = MCAIRO_svg_surface_error(status);
+ Surface = NULL;
break;
default:
@@ -164,7 +141,9 @@ create_surface(FileName, Height, Width, Surface, !IO) :-
\"unknown SVG surface status\");
}
#else
- MaybeSurface = MCAIRO_svg_surface_unsupported();
+ Supported = MR_NO;
+ Status = CAIRO_STATUS_SUCCESS;
+ Surface = NULL;
#endif
").
--
2.1.2
More information about the reviews
mailing list