aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

252
Task/Bitmap/ATS/bitmap-1.ats Normal file
View file

@ -0,0 +1,252 @@
#define ATS_PACKNAME "Rosetta_Code.bitmap_task"
(*------------------------------------------------------------------*)
(* I am going to do this at the most primitive level. So here is the
"abstractified" type, or really a whole set of different types:
w-by-h pixmap of values of type a, with pixel storage at address
p. The type is linear (‘use it once and only once’). We will make
pixmap a boxed type, so its size will be equal to that of a
pointer. (This is actually a general 2-dimensional array type!
But let us ignore that.) *)
absvtype pixmap (a : t@ype, w : int, h : int, p : addr) = ptr
(* A shorthand for a pixmap with its pixel storage at "some"
address. *)
vtypedef pixmap (a : t@ype, w : int, h : int) =
[p : addr] pixmap (a, w, h, p)
(* A shorthand for a pixmap with "some" width and height, and with its
pixel storage at "some" address. *)
vtypedef pixmap (a : t@ype) = [w, h : int] pixmap (a, w, h)
(* A shorthand for a pixmap with "some" POSITIVE width and POSITIVE
height, and with its pixel storage at "some" address. *)
vtypedef pixmap1 (a : t@ype) = [w, h : pos] pixmap (a, w, h)
(*------------------------------------------------------------------*)
(* Here are definitions for a small set of operations, including the
ones requested in the task document.
But note that, in ATS, we are careful about uninitialized data. It
is POSSIBLE to create an uninitialized pixmap, but NOT possible to
set or get individual pixels, if the pixmap is not already fully
initialized by some other means (such as "fill" or "load"). *)
fn {}
pixmap_width :
{a : t@ype}
{w, h : int}
(!pixmap (a, w, h)) -<> size_t w
fn {}
pixmap_height :
{a : t@ype}
{w, h : int}
(!pixmap (a, w, h)) -<> size_t h
fn {a : t@ype}
pixmap_make_array :
(* Make a new pixmap from an existing array. The array may be
anywhere (for instance, a stack frame or the heap), and need not
be initialized. *)
{w, h : int} {p : addr}
(array_v (a, p, w * h) | size_t w, size_t h, ptr p) ->
pixmap (a, w, h, p)
fn {a : t@ype}
pixmap_unmake :
(* Essentially the reverse of pixmap_make_array. Temporarily treat a
pixmap as an array. The array will be organized as rows from left
to right, with the rows themselves going from top to bottom. Thus
an index would be i = x + (y * w). *)
{w, h : int} {p : addr}
pixmap (a, w, h, p) ->
@(array_v (a, p, w * h) | size_t w, size_t h, ptr p)
prfn
pixmap_prove_index_bounds :
(* A proof that i = x + (y * w) is within bounds of the array
returned by pixmap_unmake. *)
{w, h : int}
{x, y : nat | x < w; y < h}
() -<prf>
[0 <= x + (y * w);
x + (y * w) < w * h]
void
fn {a : t@ype}
pixmap_make_uninitized :
(* Make a new uninitialized pixmap, with the pixels stored in the
heap. *)
{w, h : int}
(size_t w, size_t h) ->
[p : addr | null < p] @(mfree_gc_v p | pixmap (a?, w, h, p))
fn {a : t@ype}
pixmap_make_elt :
(* Make a new pixmap, initialized with a given element, with the
pixels stored in the heap. *)
{w, h : int}
(size_t w, size_t h, a) ->
[p : addr | null < p] @(mfree_gc_v p | pixmap (a, w, h, p))
fn {}
pixmap_free_storage_return :
(* Free a pixmap, returning the storage array to the user. *)
{a : t@ype}
{w, h : int} {p : addr}
pixmap (a, w, h, p) -> @(array_v (a, p, w * h) | ptr p)
fn {}
pixmap_free_storage_free :
(* If a pixmap's pixels were allocated in the heap, then free its
storage. *)
{a : t@ype}
{w, h : int} {p : addr}
(mfree_gc_v p | pixmap (a, w, h, p)) -> void
fn {a : t@ype}
pixmap_fill_elt :
(* Fill a pixmap with the given element. (Technically speaking, the
value of the first argument is consumed, and replaced by a new
value. Its type before and after is linear.) *)
{w, h : int} {p : addr}
(* The question mark means that the pixmap elements can start out
uninitialized. *)
(!pixmap (a?, w, h, p) >> pixmap (a, w, h, p), a) -> void
fn {a : t@ype}
{tk : tkind}
pixmap_set_at_guint :
(* Set a pixel at unsigned integer coordinates. You can do this only
on a pixmap that has been initialized. (It would be prohibitively
tedious to safely work with randomly located pixels, if the array
were not already fully initialized.) *)
{w, h : int}
{x, y : int | x < w; y < h}
(!pixmap (a, w, h), g1uint (tk, x), g1uint (tk, y), a) -> void
fn {a : t@ype}
{tk : tkind}
pixmap_set_at_gint :
(* Set a pixel, but with signed integer coordinates. *)
{w, h : int}
{x, y : nat | x < w; y < h}
(!pixmap (a, w, h), g1int (tk, x), g1int (tk, y), a) -> void
fn {a : t@ype} {tk : tkind}
pixmap_get_at_guint :
(* Get a pixel at unsigned integer coordinates. You can do this only
on a pixmap that has been initialized. *)
{w, h : int}
{x, y : int | x < w; y < h}
(!pixmap (a, w, h), g1uint (tk, x), g1uint (tk, y)) -> a
fn {a : t@ype} {tk : tkind}
pixmap_get_at_gint :
(* Get a pixel, but with signed integer coordinates. *)
{w, h : int}
{x, y : nat | x < w; y < h}
(!pixmap (a, w, h), g1int (tk, x), g1int (tk, y)) -> a
fn {a : t@ype}
pixmap_dump :
(* Dump the contents of a pixmap to an output stream, row by row as
in a PPM. You must implement the pixmap$pixels_dump template
function. (We are anticipating the task to write a PPM file, and
wish to do it in a nice way. I am likely to end up actually using
this code, after all.) *)
{w, h : int}
(* I return a success-or-failure value, to avoid committing to using
an exception here. There are circumstances in which exceptions are
not the best approach. *)
(FILEref, !pixmap (a, w, h)) -> bool (* success *)
fn {a : t@ype}
pixmap$pixels_dump :
(* A function that the writes n pixels to an output stream. (It
could be one pixel, it could be the entire image. From the user's
standpoint, it makes no difference. It is an implementation
detail HOW the function is called by pixmap_dump.) *)
{n : int}
(FILEref, &array (a, n), size_t n) -> bool (* success *)
fn {a : t@ype}
pixmap_load :
(* Load the contents of a pixmap from an input stream, row by row as
in a PPM. You must implement the pixmap$pixels_load template
function. A value of type a has to be given, to initialize the
array with if the loading fails. *)
{w, h : int} {p : addr}
(FILEref, !pixmap (a?, w, h, p) >> pixmap (a, w, h, p), a) ->
bool (* success *)
fn {a : t@ype}
pixmap$pixels_load :
(* A function that the reads n pixels from an input stream. (It
could be one pixel, it could be the entire image. From the user's
standpoint, it makes no difference. It is an implementation
detail HOW the function is called by pixmap_load.) *)
{n : int}
(FILEref, &array (a?, n) >> array (a, n), size_t n, a) ->
bool (* success *)
overload pixmap_make with pixmap_make_array
overload pixmap_make with pixmap_make_uninitized
overload pixmap_make with pixmap_make_elt
overload pixmap_free with pixmap_free_storage_return
overload pixmap_free with pixmap_free_storage_free
overload free with pixmap_free_storage_free
overload fill with pixmap_fill_elt
overload pixmap_set_at with pixmap_set_at_guint
overload pixmap_set_at with pixmap_set_at_gint
overload [] with pixmap_set_at
overload pixmap_get_at with pixmap_get_at_guint
overload pixmap_get_at with pixmap_get_at_gint
overload [] with pixmap_get_at
overload dump with pixmap_dump
overload load with pixmap_load
overload width with pixmap_width
overload height with pixmap_height
(*------------------------------------------------------------------*)
(* Here is a type for 24-bit RGB data. An RGB pixmap type thus can be
written as "pixmap (rgb24, w, h, p)".
There are, though you cannot see it here (they are in the dynamic
file), default implementations of pixmap$pixels_dump<rgb24> and
pixmap$pixels_load<rgb24>. These implementations are for dumping
raw data in PPM format. *)
(* It is an abstract type, the size of a triple of uint8. (It is, in
fact, a triple of uint8, but we hide this fact, so the template
system will not confuse the type with other triples of uint8. It is
a subtle matter. *)
abst@ype rgb24 = @(uint8, uint8, uint8)
fn {tk : tkind}
rgb24_make_uint_uint_uint :
(g0uint tk, g0uint tk, g0uint tk) -<> rgb24
fn {tk : tkind}
rgb24_make_int_int_int :
(g0int tk, g0int tk, g0int tk) -<> rgb24
fn {}
rgb24_make_tuple : @(uint8, uint8, uint8) -<> rgb24
fn {}
rgb24_values : rgb24 -<> @(uint8, uint8, uint8)
overload rgb24_make with rgb24_make_uint_uint_uint
overload rgb24_make with rgb24_make_int_int_int
overload rgb24_make with rgb24_make_tuple
(*------------------------------------------------------------------*)

374
Task/Bitmap/ATS/bitmap-2.ats Normal file
View file

@ -0,0 +1,374 @@
(*------------------------------------------------------------------*)
#define ATS_DYNLOADFLAG 0
#define ATS_PACKNAME "Rosetta_Code.bitmap_task"
#include "share/atspre_staload.hats"
staload "bitmap_task.sats"
(*------------------------------------------------------------------*)
(* The actual type, normally not seen by the user, is a boxed
record. *)
datavtype _pixmap (a : t@ype, w : int, h : int, p : addr) =
| _pixmap of
@{
pf = array_v (a, p, w * h) |
w = size_t w,
h = size_t h,
p = ptr p
}
(* Here is one of the ways to tie an abstract type to its
implementation: *)
assume pixmap (a, w, h, p) = _pixmap (a, w, h, p)
(* Another way is to use casts. *)
(*------------------------------------------------------------------*)
implement {}
pixmap_width pix =
case+ pix of _pixmap record => record.w
implement {}
pixmap_height pix =
case+ pix of _pixmap record => record.h
implement {a}
pixmap_make_array (pf | w, h, p) =
_pixmap @{pf = pf | w = w, h = h, p = p}
implement {a}
pixmap_unmake pix =
case+ pix of
| ~ _pixmap @{pf = pf | w = w, h = h, p = p} => @(pf | w, h, p)
primplement
pixmap_prove_index_bounds {w, h} {x, y} () =
let
prval () = mul_gte_gte_gte {y, w} ()
prval () = mul_gte_gte_gte {h - (y + 1), w} ()
in
end
implement {a}
pixmap_make_uninitized {w, h} (w, h) =
let
prval () = lemma_g1uint_param w (* Proves w >= 0. *)
prval () = lemma_g1uint_param h (* Proves h >= 0. *)
prval () = mul_gte_gte_gte {w, h} () (* Proves w*h >= 0. *)
val @(pf, pfgc | p) = array_ptr_alloc<a> (w * h)
val pix = pixmap_make<a?> (pf | w, h, p)
in
@(pfgc | pix)
end
implement {a}
pixmap_make_elt (w, h, elt) =
let
val @(pfgc | pix) = pixmap_make<a> (w, h)
in
fill<a> (pix, elt);
@(pfgc | pix)
end
implement {}
pixmap_free_storage_return pix =
case+ pix of
| ~ _pixmap record => @(record.pf | record.p)
implement {}
pixmap_free_storage_free (pfgc | pix) =
let
val @(pf | p) = pixmap_free pix
in
array_ptr_free (pf, pfgc | p)
end
implement {a}
pixmap_fill_elt {w, h} {p} (pix, elt) =
case+ pix of
| @ _pixmap record =>
let
prval () = lemma_g1uint_param (record.w)
prval () = lemma_g1uint_param (record.h)
prval () = mul_gte_gte_gte {w, h} ()
stadef n = w * h
val n : size_t n = record.w * record.h
and p : ptr p = record.p
fun
loop {i : nat | i <= n}
.<n - i>.
(pf_lft : array_v (a, p, i),
pf_rgt : array_v (a?, p + (i * sizeof a), n - i) |
i : size_t i)
: @(array_v (a, p, n) | ) =
if i = n then
let
prval () = array_v_unnil pf_rgt
in
@(pf_lft | )
end
else
let
prval @(pf_elt, pf_rgt) = array_v_uncons pf_rgt
val () = ptr_set<a> (pf_elt | ptr_add<a> (p, i), elt)
prval pf_lft = array_v_extend (pf_lft, pf_elt)
in
loop (pf_lft, pf_rgt | succ i)
end
val @(pf | ) = loop (array_v_nil (), record.pf | i2sz 0)
prval () = record.pf := pf
prval () = fold@ pix
in
end
implement {a} {tk}
pixmap_set_at_guint {w, h} {x, y} (pix, x, y, elt) =
case+ pix of
| @ _pixmap record =>
let
prval () = lemma_g1uint_param x
prval () = lemma_g1uint_param y
stadef n = w * h
stadef i = x + (y * w)
prval () = pixmap_prove_index_bounds {w, h} {x, y} ()
prval () = prop_verify {0 <= i && i < n} ()
(* I purposely store the data in an order such that you can
write something such as a PPM without looping separately
over x and y. Also, even if you did do an outer loop over y
and an inner loop over x, you would get the advantage of
data locality. *)
val i : size_t i = g1u2u x + (g1u2u y * record.w)
macdef pixels = !(record.p)
val () = pixels[i] := elt
prval () = fold@ pix
in
end
implement {a} {tk}
pixmap_set_at_gint (pix, x, y, elt) =
pixmap_set_at_guint<a><sizeknd> (pix, g1i2u x, g1i2u y, elt)
implement {a} {tk}
pixmap_get_at_guint {w, h} {x, y} (pix, x, y) =
case+ pix of
| @ _pixmap record =>
let
prval () = lemma_g1uint_param x
prval () = lemma_g1uint_param y
stadef n = w * h
stadef i = x + (y * w)
prval () = pixmap_prove_index_bounds {w, h} {x, y} ()
prval () = prop_verify {0 <= i && i < n} ()
val i : size_t i = g1u2u x + (g1u2u y * record.w)
macdef pixels = !(record.p)
val elt = pixels[i]
prval () = fold@ pix
in
elt
end
implement {a} {tk}
pixmap_get_at_gint (pix, x, y) =
pixmap_get_at_guint<a><sizeknd> (pix, g1i2u x, g1i2u y)
implement {a}
pixmap_dump (outf, pix) =
case+ pix of
| @ _pixmap record =>
let
macdef pixels = !(record.p)
val n = record.w * record.h
val success = pixmap$pixels_dump<a> (outf, pixels, n)
prval () = fold@ pix
in
success
end
implement {a}
pixmap_load (inpf, pix, elt) =
case+ pix of
| @ _pixmap record =>
let
macdef pixels = !(record.p)
val n = record.w * record.h
val success = pixmap$pixels_load<a> (inpf, pixels, n, elt)
prval () = fold@ pix
in
success
end
(*------------------------------------------------------------------*)
typedef FILEstar = $extype"FILE *"
extern castfn FILEref2star : FILEref -<> FILEstar
implement
pixmap$pixels_dump<rgb24> (outf, pixels, n) =
let
val num_written =
$extfcall (size_t, "fwrite", addr@ pixels, sizeof<rgb24>, n,
FILEref2star outf)
in
num_written = n
end
implement
pixmap$pixels_load<rgb24> (inpf, pixels, n, elt) =
let
prval [n : int] EQINT () = eqint_make_guint n
val num_read =
$extfcall (size_t, "fread", addr@ pixels, sizeof<rgb24>, n,
FILEref2star inpf)
in
if num_read = n then
let
prval () = $UNSAFE.castvwtp2void{@[rgb24][n]} pixels
in
true
end
else
begin
array_initize_elt<rgb24> (pixels, n, elt);
false
end
end
(*------------------------------------------------------------------*)
assume rgb24 = @(uint8, uint8, uint8)
implement {tk}
rgb24_make_uint_uint_uint (r, g, b) =
let
(* The prelude tends to miss implementations for type conversions
to uint8, so let us at least implement conversion from uint to
uint8. (I do not wish to use a general unsafe cast, because
that sort of code has caused me bugs before. C does not always
know how to do a type conversion correctly.) The ats2-xprelude
package has a much more complete set of implementations
(generated en masse by m4 macros), but for this task I am
avoiding such dependencies. *)
implement
g0uint2uint<uintknd,uint8knd> i =
let
extern castfn g0uint2uint_uint_uint8 : uint -<> uint8
in
g0uint2uint_uint_uint8 i
end
in
rgb24_make_tuple @(g0u2u r, g0u2u g, g0u2u b)
end
implement {tk}
rgb24_make_int_int_int (r, g, b) =
let
(* See the comment in rgb24_make_uint_uint_uint. *)
implement
g0int2uint<intknd,uint8knd> i =
let
extern castfn g0int2uint_int_uint8 : int -<> uint8
in
g0int2uint_int_uint8 i
end
in
rgb24_make @(g0i2u r, g0i2u g, g0i2u b)
end
implement {}
rgb24_make_tuple tup = tup
implement {}
rgb24_values rgb = rgb
(*------------------------------------------------------------------*)
#ifdef BITMAP_TASK_TEST #then
%{^
#include <limits.h>
%}
fn
test_sizeof_rgb24 () : void =
(* We want to be sure rgb24 takes up exactly 24 bits. Our dump and
load implementations depend on that. (If it prove not the case on
some platform, one can write, for that unanticipated platform,
special implementations of dump and load.) *)
let
val- true = sizeof<rgb24> = i2sz 3
val- true = sizeof<rgb24> * $extval (size_t, "CHAR_BIT") = i2sz 24
in
end
fn
test_pixel_load_copy_dump () : void =
(* Test loading, copying, and dumping of raw 24-bit RGB data from
SIPI image "Peppers", 4.2.07.tiff:
https://sipi.usc.edu/database/database.php?volume=misc&image=13#top
I have the data stored as "4.2.07.raw". *)
let
val failure_color = rgb24_make (0xFF, 0x00, 0x00)
val @(pfgc1 | pix1) = pixmap_make<rgb24> (i2sz 512, i2sz 512)
val inpf = fileref_open_exn ("4.2.07.raw", file_mode_r)
val success = load<rgb24> (inpf, pix1, failure_color)
val () = fileref_close inpf
val- true = success
val @(pfgc2 | pix2) = pixmap_make<rgb24> (i2sz 512, i2sz 512,
failure_color)
fun
copy_pixels {x, y : nat | x <= 512; y <= 512}
.<512 - x, 512 - y>.
(pix1 : !pixmap (rgb24, 512, 512),
pix2 : !pixmap (rgb24, 512, 512),
x : int x,
y : int y) : void =
if x = 512 then
()
else if y = 512 then
copy_pixels (pix1, pix2, succ x, 0)
else
begin
pix2[x, y] := pix1[x, y];
copy_pixels (pix1, pix2, x, succ y)
end
val () = copy_pixels (pix1, pix2, 0, 0)
val outf = fileref_open_exn ("4.2.07.raw.dumped", file_mode_w)
val success = dump<rgb24> (outf, pix2)
val () = fileref_close outf
val- true = success
val status = $extfcall (int, "system",
"cmp 4.2.07.raw 4.2.07.raw.dumped")
val- true = status = 0
in
free (pfgc1 | pix1);
free (pfgc2 | pix2)
end
implement
main0 () =
begin
test_sizeof_rgb24 ();
test_pixel_load_copy_dump ()
end
#endif
(*------------------------------------------------------------------*)