103 lines
3.3 KiB
Text
103 lines
3.3 KiB
Text
|
#define ATS_DYNLOADFLAG 0 (* No initialization is needed. *)
|
|||
|
|
|
|||
|
|
#include "share/atspre_define.hats"
|
|||
|
|
#include "share/atspre_staload.hats"
|
|||
|
|
|
|||
|
|
(********************************************************************)
|
|||
|
|
(* *)
|
|||
|
|
(* Declarations. *)
|
|||
|
|
(* *)
|
|||
|
|
(* (These could be ported to a .sats file.) *)
|
|||
|
|
(* *)
|
|||
|
|
|
|||
|
|
(* lcm for unsigned integer types without constraints. *)
|
|||
|
|
extern fun {tk : tkind}
|
|||
|
|
g0uint_lcm (u : g0uint tk,
|
|||
|
|
v : g0uint tk) :<>
|
|||
|
|
g0uint tk
|
|||
|
|
|
|||
|
|
(* The gcd template function to be expanded when g0uint_lcm is
|
|||
|
|
expanded. Set it to your favorite gcd function. *)
|
|||
|
|
extern fun {tk : tkind}
|
|||
|
|
g0uint_lcm$gcd (u : g0uint tk,
|
|||
|
|
v : g0uint tk) :<>
|
|||
|
|
g0uint tk
|
|||
|
|
|
|||
|
|
(* lcm for signed integer types, giving unsigned results. *)
|
|||
|
|
extern fun {tk_signed, tk_unsigned : tkind}
|
|||
|
|
g0int_lcm (u : g0int tk_signed,
|
|||
|
|
v : g0int tk_signed) :<>
|
|||
|
|
g0uint tk_unsigned
|
|||
|
|
|
|||
|
|
overload lcm with g0uint_lcm
|
|||
|
|
overload lcm with g0int_lcm
|
|||
|
|
|
|||
|
|
(********************************************************************)
|
|||
|
|
(* *)
|
|||
|
|
(* The implementations. *)
|
|||
|
|
(* *)
|
|||
|
|
|
|||
|
|
implement {tk}
|
|||
|
|
g0uint_lcm (u, v) =
|
|||
|
|
let
|
|||
|
|
val d = g0uint_lcm$gcd<tk> (u, v)
|
|||
|
|
in
|
|||
|
|
(* There is no need to take the absolute value, because this
|
|||
|
|
implementation is strictly for unsigned integers. *)
|
|||
|
|
(u * v) / d
|
|||
|
|
end
|
|||
|
|
|
|||
|
|
implement {tk_signed, tk_unsigned}
|
|||
|
|
g0int_lcm (u, v) =
|
|||
|
|
let
|
|||
|
|
extern castfn
|
|||
|
|
unsigned :
|
|||
|
|
g0int tk_signed -<> g0uint tk_unsigned
|
|||
|
|
in
|
|||
|
|
g0uint_lcm (unsigned (abs u), unsigned (abs v))
|
|||
|
|
end
|
|||
|
|
|
|||
|
|
(********************************************************************)
|
|||
|
|
(* *)
|
|||
|
|
(* A test that it actually works. *)
|
|||
|
|
(* *)
|
|||
|
|
|
|||
|
|
implement
|
|||
|
|
main0 () =
|
|||
|
|
let
|
|||
|
|
implement {tk}
|
|||
|
|
g0uint_lcm$gcd (u, v) =
|
|||
|
|
(* An ugly gcd for the sake of demonstrating that it can be done
|
|||
|
|
this way: Euclid’s algorithm written an the ‘Algol’ style,
|
|||
|
|
which is not a natural style in ATS. Almost always you want
|
|||
|
|
to write a tail-recursive function, instead. I did, however
|
|||
|
|
find the ‘Algol’ style very useful when I was migrating
|
|||
|
|
matrix routines from Fortran.
|
|||
|
|
|
|||
|
|
In reality, you would implement g0uint_lcm$gcd by having it
|
|||
|
|
simply call whatever gcd template function you are using in
|
|||
|
|
your program. *)
|
|||
|
|
$effmask_all
|
|||
|
|
begin
|
|||
|
|
let
|
|||
|
|
var x : g0uint tk = u
|
|||
|
|
var y : g0uint tk = v
|
|||
|
|
in
|
|||
|
|
while (y <> 0)
|
|||
|
|
let
|
|||
|
|
val z = y
|
|||
|
|
in
|
|||
|
|
y := x mod z;
|
|||
|
|
x := z
|
|||
|
|
end;
|
|||
|
|
x
|
|||
|
|
end
|
|||
|
|
end
|
|||
|
|
in
|
|||
|
|
assertloc (lcm (~6, 14) = 42U);
|
|||
|
|
assertloc (lcm (2L, 0L) = 0ULL);
|
|||
|
|
assertloc (lcm (12UL, 18UL) = 36UL);
|
|||
|
|
assertloc (lcm (12, 22) = 132ULL);
|
|||
|
|
assertloc (lcm (7ULL, 31ULL) = 217ULL)
|
|||
|
|
end
|