[LINT68][COMMITTED] Add Rat68 prelude
Jose E. Marchesi
jemarch@gnu.org
Sat Jun 13 20:07:49 GMT 2026
---
README | 4 +
src/Makefile.am | 8 +-
src/{liblint68.a68 => lint68.a68} | 14 +-
src/rat68.a68 | 330 ++++++++++++++++++++++++++++++
4 files changed, 346 insertions(+), 10 deletions(-)
create mode 100644 README
rename src/{liblint68.a68 => lint68.a68} (99%)
create mode 100644 src/rat68.a68
diff --git a/README b/README
new file mode 100644
index 0000000..2135b8c
--- /dev/null
+++ b/README
@@ -0,0 +1,4 @@
+This project contains two Algol 68 preludes:
+
+ Lint68 - provides arbitrary precision integral values.
+ Rat68 - provides arbitrary precision rational values.
diff --git a/src/Makefile.am b/src/Makefile.am
index bee617b..0ecaed0 100644
--- a/src/Makefile.am
+++ b/src/Makefile.am
@@ -17,8 +17,12 @@
AM_A68FLAGS = -std=gnu68 -fcheck=nil
-lib_LTLIBRARIES = liblint68.la
-liblint68_la_SOURCES = liblint68.a68
+lib_LTLIBRARIES = liblint68.la librat68.la
+
+liblint68_la_SOURCES = lint68.a68
+librat68_la_SOURCES = rat68.a68
+
+libra68_la_LIBADD = liblint68.la
# Dependencies.
# In the future will be generated by ga68 -MD deps.mk (-M -MF deps.mk).
diff --git a/src/liblint68.a68 b/src/lint68.a68
similarity index 99%
rename from src/liblint68.a68
rename to src/lint68.a68
index 884eb57..5795433 100644
--- a/src/liblint68.a68
+++ b/src/lint68.a68
@@ -1,6 +1,4 @@
-{ Lint68 - Integer arithmetic for arbitrary large numbers.
-
- This code is a port of the prelude described in:
+{ This code is a port of the prelude described in:
ALGOL 68 PRELUDES FOR ARITHMETIC IN Z and Q
(second edition)
@@ -73,9 +71,9 @@ def
mode ShortIntC = struct (ShortInt nmb, carry);
{ Basic arithmetic operations
- ───────────────────────────
+ ─────────────────────────── }
- For nonnegative single and double ShortInt values.
+ { For nonnegative single and double ShortInt values.
cf. D.E. Knuth : The Art of Computer Programming, p.230. }
{ In the procedures below the "k" parameter is the old carry, = 0
@@ -252,9 +250,9 @@ def
pub op I = (Lint u) int: LONGTOINT u;
{ Basic LongInt operations
- ────────────────────────
+ ──────────────────────── }
- The algorithms for +, -, *, %, %* are designed for the case that
+ { The algorithms for +, -, *, %, %* are designed for the case that
both operands and the result are non-negative. The other cases
are solved recursively using monadic minus. }
@@ -798,7 +796,7 @@ def
od;
(negative | -result | result)
end;
-
+
pub proc longwhole = (LongInt x, int width) string:
begin
LongInt absx := ABS x;
diff --git a/src/rat68.a68 b/src/rat68.a68
new file mode 100644
index 0000000..81bad76
--- /dev/null
+++ b/src/rat68.a68
@@ -0,0 +1,330 @@
+{ This code is a port of the prelude described in:
+
+ ALGOL 68 PRELUDES FOR ARITHMETIC IN Z and Q
+ (second edition)
+
+ by Guenter Baszenski and W. Tohn.
+
+ Port by Jose E. Marchesi, consisting on:
+
+ 1. Adapt from the point stropping used in the published work to
+ modern stropping supported by ga68.
+ 2. Added some additional commentary.
+ 3. Several code improvements.
+
+ Note that the origin form of this code is Copyright 1983
+ Rechenzentrum der Ruhr-Universitaet, published in the form of a book
+ under the following terms:
+
+ Vervielfaeltigung oder Nachdruck, auch auszugsweise, nur unter
+ Quellenangabe bei Ueberlassung von 3 Belegexemplaren gestattet.
+
+ I am in the process of obtaining permission to distribute this
+ modified form under free softwar terms. In the meanwhile, use this
+ under your own responsibility. }
+
+module Rat68 = access Lint68
+def
+ { The representation of a fractional
+
+ q = (numerator'q) / (denominator'q)
+
+ is always such that denominator'q > 0 and GCD (numerator'q,
+ denominator'q) = 1 }
+
+ pub mode Rat = struct (LongInt numerator, denominator);
+
+ { Internal operations
+ ─────────────────── }
+
+ { Operators N, D, NN, ND, DD are defined for local use within the
+ definitions of this prelude only. }
+
+ op N = (Rat q) LongInt: numerator'q,
+ D = (Rat q) LongInt: denominator'q;
+
+ prio NN = 7, ND = 7, DD = 7;
+
+ op NN = (Rat p,q) LongInt: N p * N q,
+ ND = (Rat p,q) LongInt: N p * D q,
+ DD = (Rat p,q) LongInt: D p * D q;
+
+ { Relational operations
+ ───────────────────── }
+
+ pub op < = (Rat p,q) bool: p ND q < q ND p,
+ < = (Rat p, LongInt q) bool: N p < q * D p,
+ < = (LongInt p, Rat q) bool: p * D q < N q,
+ < = (Rat p, int q) bool: p < INTTOLONG q,
+ < = (int p, Rat q) bool: INTTOLONG p < q;
+
+ pub op > = (Rat p,q) bool: p ND q > q ND p,
+ > = (Rat p, LongInt q) bool: N p > q * D p,
+ > = (LongInt p, Rat q) bool: p * D q > N q,
+ > = (Rat p, int q) bool: p > INTTOLONG q,
+ > = (int p, Rat q) bool: INTTOLONG p > q;
+
+ pub op <= = (Rat p,q) bool: p ND q <= q ND p,
+ <= = (Rat p, LongInt q) bool: N p <= q * D p,
+ <= = (LongInt p, Rat q) bool: p * D q <= N q,
+ <= = (Rat p, int q) bool: p <= INTTOLONG q,
+ <= = (int p, Rat q) bool: INTTOLONG p <= q;
+
+ pub op >= = (Rat p,q) bool: p ND q >= q ND p,
+ >= = (Rat p, LongInt q) bool: N p >= q * D p,
+ >= = (LongInt p, Rat q) bool: p * D q >= N q,
+ >= = (Rat p, int q) bool: p >= INTTOLONG q,
+ >= = (int p, Rat q) bool: INTTOLONG p >= q;
+
+ pub op = = (Rat p,q) bool: N p = N q AND D p = D q,
+ = = (Rat p, LongInt q) bool: N p = q AND D p = 1,
+ = = (LongInt p, Rat q) bool: p = N q AND D q = 1,
+ = = (Rat p, int q) bool: p = INTTOLONG q,
+ = = (int p, Rat q) bool: INTTOLONG p = q;
+
+ pub op /= = (Rat p,q) bool: NOT (p=q),
+ /= = (Rat p, LongInt q) bool: NOT (p=q),
+ /= = (LongInt p, Rat q) bool: NOT (p=q),
+ /= = (Rat p, int q) bool: NOT (p=q),
+ /= = (int p, Rat q) bool: NOT (p=q);
+
+ pub op LT = (Rat p,q) bool: p ND q < q ND p,
+ LT = (Rat p, LongInt q) bool: N p < q * D p,
+ LT = (LongInt p, Rat q) bool: p * D q < N q,
+ LT = (Rat p, int q) bool: p < INTTOLONG q,
+ LT = (int p, Rat q) bool: INTTOLONG p < q;
+
+ pub op GT = (Rat p,q) bool: p ND q > q ND p,
+ GT = (Rat p, LongInt q) bool: N p > q * D p,
+ GT = (LongInt p, Rat q) bool: p * D q > N q,
+ GT = (Rat p, int q) bool: p > INTTOLONG q,
+ GT = (int p, Rat q) bool: INTTOLONG p > q;
+
+ pub op LE = (Rat p,q) bool: p ND q <= q ND p,
+ LE = (Rat p, LongInt q) bool: N p <= q * D p,
+ LE = (LongInt p, Rat q) bool: p * D q <= N q,
+ LE = (Rat p, int q) bool: p <= INTTOLONG q,
+ LE = (int p, Rat q) bool: INTTOLONG p <= q;
+
+ pub op GE = (Rat p,q) bool: p ND q >= q ND p,
+ GE = (Rat p, LongInt q) bool: N p >= q * D p,
+ GE = (LongInt p, Rat q) bool: p * D q >= N q,
+ GE = (Rat p, int q) bool: p >= INTTOLONG q,
+ GE = (int p, Rat q) bool: INTTOLONG p >= q;
+
+ pub op EQ = (Rat p,q) bool: N p = N q AND D p = D q,
+ EQ = (Rat p, LongInt q) bool: N p = q AND D p = 1,
+ EQ = (LongInt p, Rat q) bool: p = N q AND D q = 1,
+ EQ = (Rat p, int q) bool: p = INTTOLONG q,
+ EQ = (int p, Rat q) bool: INTTOLONG p = q;
+
+ pub op NE = (Rat p,q) bool: NOT (p=q),
+ NE = (Rat p, LongInt q) bool: NOT (p=q),
+ NE = (LongInt p, Rat q) bool: NOT (p=q),
+ NE = (Rat p, int q) bool: NOT (p=q),
+ NE = (int p, Rat q) bool: NOT (p=q);
+
+ { Monadic operations
+ ────────────────── }
+
+ pub op ABS = (Rat q) Rat: (ABS N q, D q);
+
+ pub op ENTIER = (Rat q) LongInt:
+ (N q >= 0 | N q % D q | N q % D q - 1);
+
+ { Fractional part of "q" }
+
+ pub op FRAC = (Rat q) Rat: q - ENTIER q;
+
+ pub op ROUND = (Rat q) LongInt:
+ if Rat frac_q = FRAC q;
+ frac_q > 1 FR 2 OR frac_q = 1 FR 2 AND q < 0
+ then ENTIER q + 1
+ else ENTIER q
+ fi;
+
+ pub op SIGN = (Rat q) int: SIGN N q,
+ WHOLE = (Rat q) bool: D q = 1;
+
+ pub op + = (Rat q) Rat: q,
+ - = (Rat q) Rat: (- N q, D q);
+
+ { Conversion int -> Rat, LongInt -> Rat
+ ───────────────────────────────────── }
+
+ pub op INTTORAT = (int i) Rat: i FR 1;
+
+ pub op LONGINTTORAT = (LongInt i) Rat: i FR 1;
+
+ pub op R = (int i) Rat: i FR 1,
+ R = (LongInt i) Rat: i FR 1;
+
+ { Arithmetic operations
+ ───────────────────── }
+
+ pub prio FR = 8;
+
+ { The rational number a/b }
+
+ pub op FR = (LongINt a,b) Rat:
+ if b /= 0
+ then LongInt gcd = a GCD b;
+ if b < 0
+ then (-a%gcd, -b%gcd)
+ else (a%gcd, b%gcd)
+ fi
+ else raterror("operator FR: denominator is zero, numerator = "
+ + longwhole(a,0));
+ skip
+ fi;
+
+ pub op FR = (LongInt a, int b) Rat: a FR INTTOLONG b,
+ FR = (int a, LongInt b) Rat: INTTOLONG a FR b,
+ FR = (int a,b) Rat: INTTOLONG a FR INTTOLONG b;
+
+ pub op + = (Rat p,q) Rat: (p ND q + q ND p) FR (p DD q),
+ + = (Rat p, LongInt q) Rat: p + q FR 1,
+ + = (LongInt p, Rat q) Rat: q + p,
+ + = (Rat p, int q) Rat: p + INTTOLONG q FR 1,
+ + = (int p, Rat q) Rat: INTTOLONG p FR 1 + q;
+
+ pub op - = (Rat p,q) Rat: (p ND q - q ND p) FR (p DD q),
+ - = (Rat p, LongInt q) Rat: p - q FR 1,
+ - = (LongInt p, Rat q) Rat: q - p,
+ - = (Rat p, int q) Rat: p - INTTOLONG q FR 1,
+ - = (int p, Rat q) Rat: INTTOLONG p FR 1 - q;
+
+ pub op * = (Rat p,q) Rat: (p NN q) FR (p DD q),
+ * = (Rat p, LongInt q) Rat: (N p * q) FR D p,
+ * = (LongInt p, Rat q) Rat: q * p,
+ * = (Rat p, int q) Rat: (N p * INTTOLONG q) FR D p,
+ * = (int p, Rat q) Rat: q * p;
+
+ pub op / = (Rat p,q) Rat: (p ND q) FR (q ND p),
+ / = (Rat p, LongInt q) Rat: N p FR (D p * q),
+ / = (LongInt p, Rat q) Rat: (p * D q) FR N q,
+ / = (Rat p, int q) Rat: N p FR (D p * INTTOLONG q),
+ / = (int p, Rat q) Rat: (INTTOLONG p * D q) FR N q;
+
+ pub op / = (LongInt u,v) Rat: u FR v,
+ / = (LongInt u, int v) Rat: u FR v,
+ / = (int u, LongInt v) Rat: u FR v;
+
+ pub op ** = (Rat p, LongInt n) Rat:
+ if n >= 0
+ then (N p**n, D p**n)
+ elif N p > 0
+ then (D p **-n, N p **-n)
+ elif N p < 0
+ then (-D p**-n, -N p**-n)
+ else raterror("operator **, power negative, base zero");
+ skip
+ fi;
+
+ pub op ** = (Rat p, int n) Rat: p ** INTTOLONG n;
+
+ pub op ^ = (Rat p, LongInt n) Rat: p**n,
+ ^ = (Rat p, int n) Rat: p**n;
+
+ { Operations combined with assignations
+ ───────────────────────────────────── }
+
+ pub op +:= = (ref Rat p, Rat q) ref Rat: p := p+q,
+ +:= = (ref Rat p, LongInt q) ref Rat: p := p+q,
+ +:= = (ref Rat p, int q) ref Rat: p := p+q;
+
+ pub op -:= = (ref Rat p, Rat q) ref Rat: p := p-q,
+ -:= = (ref Rat p, LongInt q) ref Rat: p := p-q,
+ -:= = (ref Rat p, int q) ref Rat: p := p-q;
+
+ pub op *:= = (ref Rat p, Rat q) ref Rat: p := p*q,
+ *:= = (ref Rat p, LongInt q) ref Rat: p := p*q,
+ *:= = (ref Rat p, int q) ref Rat: p := p*q;
+
+ pub op /:= = (ref Rat p, Rat q) ref Rat: p := p/q,
+ /:= = (ref Rat p, LongInt q) ref Rat: p := p/q,
+ /:= = (ref Rat p, int q) ref Rat: p := p/q;
+
+ pub op PLUSAB = (ref Rat p, Rat q) ref Rat: p := p+q,
+ PLUSAB = (ref Rat p, LongInt q) ref Rat: p := p+q,
+ PLUSAB = (ref Rat p, int q) ref Rat: p := p+q;
+
+ pub op MINUSAB = (ref Rat p, Rat q) ref Rat: p := p-q,
+ MINUSAB = (ref Rat p, LongInt q) ref Rat: p := p-q,
+ MINUSAB = (ref Rat p, int q) ref Rat: p := p-q;
+
+ pub op TIMESAB = (ref Rat p, Rat q) ref Rat: p := p*q,
+ TIMESAB = (ref Rat p, LongInt q) ref Rat: p := p*q,
+ TIMESAB = (ref Rat p, int q) ref Rat: p := p*q;
+
+ pub op DIVAB = (ref Rat p, Rat q) ref Rat: p := p/q,
+ DIVAB = (ref Rat p, LongInt q) ref Rat: p := p/q,
+ DIVAB = (ref Rat p, int q) ref Rat: p := p/q;
+
+ { Transput routines
+ ───────────────── }
+
+ pub proc ratwhole = (Rat q, int num_width, denom_width) string:
+ longwhole(N q, num_width)
+ + if string denomstring = longwhole(D q, 0);
+ denom_width = 0
+ then if D q = 1
+ then ""
+ else "/" + denomstring
+ fi
+ elif UPB denomstring <= ABS denom_width
+ then "/" + denomstring + (ABS denom_width - UPB denomstring) * blank
+ else "/" + ABS denomwidth * errorchar
+ fi;
+
+ pub proc rwhole = (Rat q, int nwidth, dwidth) string:
+ rat_whole(q, nwidth, dwidth);
+
+ { This routine should deliver the same fixed point decimal
+ representation of "q" as fixed does for a real value. }
+
+ pub proc ratfixed = (Rat q, int width, after) string:
+ if after < 0
+ then (width = 0 | 1 | ABS width) * errorchar
+ elif after = 0
+ then longwhole(ROUND q, width)
+ elif { The last digit in the decimal representation of
+ `qround' is the last digit in the fixed repr of q
+ (if no digit places after the decimal point have
+ to be sacrificed) }
+ LongInt qround = ROUND (q * L 10 ** after);
+ string sign = (q<0 | "-" |: width>0 | "+" | "");
+ string abs_qround_string = longwhole(ABS qround, 0);
+ { If ABS qround < 0.1 then a sufficient number of leading
+ zeroes is inserted so that all positions right to the
+ decimal point are representted now. }
+ string abs_qround_string_leading_zeros
+ = (after - UPB absqroundstring)*"0" + absqroundstring;
+ int last_pos_whole_part
+ = UPB abs_qroundstring_leading_zeros - after;
+ string minimal_repr_of_q
+ = sign
+ + abs_qroundstring_leading_zeros[:last_pos_whole_part] + "."
+ + abs_qroundstring_leading_zeros[last_pos_whole_part+1:];
+ width = 0
+ then minimal_repr_of_q
+ elif UPB minimal_repr_of_q <= ABS width
+ then (ABS width - UPB minimal_repr_of_q) * blank + minimal_repr_of_q
+ elif int minimal_number_positions_required
+ = last_pos_whole_part + (q<0 OR width > 0 | 1 | 0);
+ minimal_number_positions_required > ABS width
+ then ABS width * errorchar
+ else ratfixed(q, width, ABS width - minimal_number_positions_required)
+ fi;
+
+ pub proc rfixed = (RAt q, int width, after) string:
+ ratfixed(q,width,after);
+
+ { Error routine
+ ───────────── }
+
+ proc raterror = (string s) void:
+ fputs(2, "error in Rat68 prelude: " + s + "'n");
+
+ skip
+fed
--
2.39.5
More information about the Algol68
mailing list