[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