++fn
Float
A mold for the floating-point arithmetic using the base of two, the formula is
(-1)^s * a * 2^e.
Produces either a float ($f), an infinity of other sign ($i),
or not-a-number ($n). s refers to sign, the flags & or |; e to
exponent, a signed decimal; and a to the significand, an unsigned integer.
Source
++ fn
$% [$f s=? e=@s a=@u]
[$i s=?]
[$n ~]
==
Examples
> *fn
[%n ~]
> (add:fl [%f & --33 2] [%f | --23 2])
[%f s=%.y e=-79 a=10.374.452.512.267.829.421.849.019.032.797.184]
> (add:fl [%i &] [%i &])
[%i s=%.y]
> (add:fl [%n ~] [%i |])
[%n ~]
> (sun:fl 961.193.554.848.514.048.973.893.027.381.506.219.443)
[%f s=%.y e=--17 a=7.333.324.850.834.000.007.430.214.137.126.970]++dn
Decimal float
A mold for the floating-point arithmetic using the base of 10; the formula is
(-1)^s * a *10^e.
Valid values are a float ($d), an infinity ($i), or a not-a-number ($n).
s refers to sign, the flags & or |; e to exponent, a signed decimal;
and a to the significand, an unsigned integer.
++ dn
$% [$d s=? e=@s a=@u]
[$i s=?]
[$n ~]
==
Examples
> `dn`[%d & --0 17.163.091.968]
[%d s=%.y e=--0 a=17.163.091.968]
> `dn`[%i s=%.y]
[%i s=%.y]
> `dn`[%n ~]
[%n ~]++rn
Parsed decimal float
A mold for the floating-point arithmetic using the base of 10; the formula is
(-1)^s * a *10^e.
Produces either a parsed float ($d), infinity of either sign ($i), or
not-a-number ($n).
Source
$% [$d a=? b=[c=@ [d=@ e=@] f=? i=@]]
[$i a=?]
[$n ~]
==
Examples
> `rn`[%d | [2 [3 4] | 17.163]]
[%d a=%.n b=[c=2 [d=3 e=4] f=%.n i=17.163]]++fl
Arbitrary-precision floating-point
Container arm for floating-point arithmetic functions.
- Precision (
p): number of bits in the significand; must be at least 2. Default is 113. - Minimum exponent (
v): minimum value of e. Default is -16.494. - Width (
w): Max value ofeminus min value ofe. 0 is for fixed-point. Default is 32.765. - Rounding mode (
r): Possible modes are nearest ($n), up ($u), down ($d), to zero ($z), and away from zero ($a). Default value is%n. - Behavior (
d): return denormals ($d), flush denormals to zero ($z), infinite exponent range ($i). Default value is%d.
Source
++ fl
=+ ^- [[p=@u v=@s w=@u] r=$?($n $u $d $z $a) d=$?($d $f $i)]
[[113 -16.494 32.765] %n %d]
=>
~% %cofl +> ~
|%
++rou:fl
Round
Rounds a to a the nearest float that can be represented with a 113-bit
significand. There is no term to sign the significand, meaning that a positive
sign will always be produced.
Accepts
a is a cell of a signed integer and an unsigned integer.
Produces
An fn.
Source
++ rou
|= [a=[e=@s a=@u]] ^- fn (rau a &)
Examples
> =a 10.161.487.211.429.486.882.397.572.894.294.017.777
> (^rou:fl [--12 a])
[%f s=%.y e=--22 a=9.923.327.354.911.608.283.591.379.779.584.002]
> (^rou:fl [--12 (add a 1)])
[%f s=%.y e=--22 a=9.923.327.354.911.608.283.591.379.779.584.002]
> (^rou:fl [--12 (add a 300)])
[%f s=%.y e=--22 a=9.923.327.354.911.608.283.591.379.779.584.002]
> (^rou:fl [--12 (add a 1.000)])
[%f s=%.y e=--22 a=9.923.327.354.911.608.283.591.379.779.584.003]++rau:fl
Various roundings
Rounds a based on what the state of of r in the core contained in fl. t
is a sticky bit that represents a value less than ULP(a) = 2^(e.a) when passed
to lug:fl.
Accepts
a is a cell of a signed integer and an unsigned integer.
t is a flag.
Produces
An fn.
Source
++ rau
|= [a=[e=@s a=@u] t=?] ^- fn
?- r
$z (lug %fl a t) $d (lug %fl a t)
$a (lug %ce a t) $u (lug %ce a t)
$n (lug %ne a t)
==
Examples
> (rau:fl [-18 342.602.577] &)
[%f s=%.y e=-102 a=6.626.897.619.228.945.634.459.505.846.648.832]Discussion
See lug:fl for possible rounding operations.
++add:fl
Add
Produces the sum of a and b. e is used to choose between an exact result
(any-sized significand) or a rounded result (113-bit significand).
There is no term to sign the significands, so a positive sign will always be produced.
Accepts
a is an fn.
b is an fn
e is a flag.
Produces
An fn.
Source
++ add
|= [a=[e=@s a=@u] b=[e=@s a=@u] e=?] ^- fn
=+ q=(dif:si e.a e.b)
|- ?. (syn:si q) $(b a, a b, q +(q)) :: a has larger exp
?: e
[%f & e.b (^add (lsh 0 (abs:si q) a.a) a.b)]
=+ [ma=(met 0 a.a) mb=(met 0 a.b)]
=+ ^= w %+ dif:si e.a %- sun:si :: expanded exp of a
?: (gth prc ma) (^sub prc ma) 0
=+ ^= x %+ sum:si e.b (sun:si mb) :: highest exp for b
?: =((cmp:si w x) --1) :: don't need to add
?- r
$z (lug %fl a &) $d (lug %fl a &)
$a (lug %lg a &) $u (lug %lg a &)
$n (lug %na a &)
==
(rou [e.b (^add (lsh 0 (abs:si q) a.a) a.b)])
Examples
> (^add:fl [--33 2.718] [--23 11] %.y)
[%f s=%.y e=--23 a=2.783.243]
> (^add:fl [--33 2.718] [--23 11] %.n)
[%f s=%.y e=-68 a=6.890.975.897.521.519.304.902.126.405.156.864]++sub:fl
Subtract
Produces the difference of a minus b. e is used to choose between an exact
result (any-sized significand) or a rounded result (113-bit significand).
Accepts
a is a cell of a signed integer and an unsigned integer.
b is a cell of a signed integer and an unsigned integer.
e is a flag.
Produces
An fn.
Source
++ sub
|= [a=[e=@s a=@u] b=[e=@s a=@u] e=?] ^- fn
=+ q=(dif:si e.a e.b)
|- ?. (syn:si q)
(fli $(b a, a b, q +(q), r swr))
=+ [ma=(met 0 a.a) mb=(met 0 a.b)]
=+ ^= w %+ dif:si e.a %- sun:si
?: (gth prc ma) (^sub prc ma) 0
=+ ^= x %+ sum:si e.b (sun:si +(mb))
?: &(!e =((cmp:si w x) --1))
?- r
$z (lug %sm a &) $d (lug %sm a &)
$a (lug %ce a &) $u (lug %ce a &)
$n (lug %nt a &)
==
=+ j=(lsh 0 (abs:si q) a.a)
|- ?. (gte j a.b)
(fli $(a.b j, j a.b, r swr))
=+ i=(^sub j a.b)
?~ i [%f & zer]
?: e [%f & e.b i] (rou [e.b i])
Examples
> (^sub:fl [--33 2.718] [--23 11] %.y)
[%f s=%.y e=--23 a=2.783.221]
> (^sub:fl [--33 2.718] [--63 11] %.y)
[%f s=%.n e=--33 a=11.811.157.346]++mul:fl
Multiply
Produces the product of a multiplied by b. There is no term to sign the
significands, so a positive sign will always be produced.
Accepts
a is a cell of a signed integer and an unsigned integer.
b is a cell of a signed integer and an unsigned integer.
Produces
An fn.
Source
++ mul
|= [a=[e=@s a=@u] b=[e=@s a=@u]] ^- fn
(rou (sum:si e.a e.b) (^mul a.a a.b))
Examples
> (^mul:fl [--3 2.718] [--23 11])
[%f s=%.y e=-72 a=9.475.054.411.405.900.661.487.108.108.582.912]++div:fl
Divide
Produces the quotient of a divided by b. There is no term to sign the
significands, so a positive sign will always be produced.
Accepts
a is a cell of a signed integer and an unsigned integer.
b is a cell of a signed integer and an unsigned integer.
Produces
An fn.
Source
++ div
|= [a=[e=@s a=@u] b=[e=@s a=@u]] ^- fn
=+ [ma=(met 0 a.a) mb=(met 0 a.b)]
=+ v=(dif:si (sun:si ma) (sun:si +((^add mb prc))))
=. a ?: (syn:si v) a
a(e (sum:si v e.a), a (lsh 0 (abs:si v) a.a))
=+ [j=(dif:si e.a e.b) q=(dvr a.a a.b)]
(rau [j p.q] =(q.q 0))
Examples
> (^div:fl [--13 2.718] [--23 11])
[%f s=%.y e=-115 a=10.023.198.055.040.952.765.870.659.817.343.907]++sqt:fl
Square root
Produces the square root of a.
Accepts
a is a cell of a signed integer and an unsigned integer.
Produces
An fn.
Source
++ sqt
|= [a=[e=@s a=@u]] ^- fn
=. a
=+ [w=(met 0 a.a) x=(^mul +(prc) 2)]
=+ ?:((^lth w x) (^sub x w) 0)
=+ ?: =((dis - 1) (dis (abs:si e.a) 1)) -
(^add - 1)
a(e (dif:si e.a (sun:si -)), a (lsh 0 - a.a))
=+ [y=(^sqt a.a) z=(fra:si e.a --2)]
(rau [z p.y] =(q.y 0))
Examples
> (^sqt:fl [-18 342.602.577])
[%f s=%.y e=-107 a=5.865.903.143.604.945.574.132.671.852.050.553]++lth:fl
Less than
Tests if a is less than b.
Accepts
a is a cell of a signed integer and an unsigned integer.
b is a cell of a signed integer and an unsigned integer.
Produces
An flag.
Source
++ lth
|= [a=[e=@s a=@u] b=[e=@s a=@u]] ^- ?
?: =(e.a e.b) (^lth a.a a.b)
=+ c=(cmp:si (ibl a) (ibl b))
?: =(c -1) & ?: =(c --1) |
?: =((cmp:si e.a e.b) -1)
(^lth (rsh 0 (abs:si (dif:si e.a e.b)) a.a) a.b)
(^lth (lsh 0 (abs:si (dif:si e.a e.b)) a.a) a.b)
Examples
> (^lth:fl [-4 684] [--0 35])
%.n
> (^lth:fl [-4 684] [--0 90])
%.y++equ:fl
Equals
Tests if a is equal to b.
Accepts
a is a cell of a signed integer and an unsigned integer.
b is a cell of a signed integer and an unsigned integer.
Produces
A flag.
Source
++ equ
|= [a=[e=@s a=@u] b=[e=@s a=@u]] ^- ?
?. =((ibl a) (ibl b)) |
?: =((cmp:si e.a e.b) -1)
=((lsh 0 (abs:si (dif:si e.a e.b)) a.b) a.a)
=((lsh 0 (abs:si (dif:si e.a e.b)) a.a) a.b)
Examples
> (^equ:fl [-4 480] [-0 50])
%.n
> (^equ:fl [-4 480] [-0 30])
%.y++ibl:fl
Integer binary logarithm
Produces the lowest power to which the number 2 must be raised to obtain a or
greater.
Accepts
a is a cell of a signed integer and an unsigned integer.
Produces
A signed integer.
Source
++ ibl
|= [a=[e=@s a=@u]] ^- @s
(sum:si (sun:si (dec (met 0 a.a))) e.a)
Examples
> (ibl:fl [-18 342.602.577])
--10++uni:fl
Change representation to odd
Produces another representation of the floating point a where the significand
is odd. Every floating-point number has a unique representation of this kind. If
the significand of a is already odd, nothing changes.
Accepts
a is a cell of a signed integer and an unsigned integer.
Produces
A cell of a signed integer and an unsigned integer.
Source
++ uni
|= [a=[e=@s a=@u]]
|- ?: =((end 0 1 a.a) 1) a
$(a.a (rsh 0 1 a.a), e.a (sum:si e.a --1))
Examples
> (uni:fl [-8 342.602.578])
[e=-7 a=171.301.289]
> (uni:fl [-8 342.602.577])
[e=-8 a=342.602.577]++xpd:fl
Expand
Produces the fully precise form of a, or the denormalized form of a.
Accepts
a is a cell of a signed integer and an unsigned integer.
Produces
A cell of a signed integer and an unsigned integer.
Sources
++ xpd
|= [a=[e=@s a=@u]]
=+ ma=(met 0 a.a)
?: (gte ma prc) a
=+ ?: =(den %i) (^sub prc ma)
=+ ^= q
=+ w=(dif:si e.a emn)
?: (syn:si w) (abs:si w) 0
(min q (^sub prc ma))
a(e (dif:si e.a (sun:si -)), a (lsh 0 - a.a))
Examples
> (xpd:fl [--3 12])
[e=-106 a=7.788.445.287.802.241.442.795.744.493.830.144]
> (xpd:fl [-8 342.602.577])
[e=-92 a=6.626.897.619.228.945.634.459.505.846.648.832]
> (xpd:fl [-92 6.626.897.619.228.945.634.459.505.846.648.832])
[e=-92 a=6.626.897.619.228.945.634.459.505.846.648.832]++lug:fl
Central rounding mechanism
Performs various rounding operations on a. An operation is chosen based on the
value selected for t. s is a sticky bit that represents a value less than
ULP(a) = 2^(e.a)
Possible rounding operations:
- Floor (
$fl) - Ceiling (
$ce) - Smaller (
$sm) - Larger (
$lg) - Nearest (
$ne) -- Rounds ties away from 0 if the number is even, rounds toward 0 if the number is odd.
Accepts
t is one of the following: $fl, $ce, $sm, $lg, $ne, $na, or $nt.
a is a cell of a signed integer and an unsigned integer.
s is a flag.
Produces
An fn.
Source
::
:: central rounding mechanism
:: can perform: floor, ceiling, smaller, larger,
:: nearest (round ties to: even, away from 0, toward 0)
:: s is sticky bit: represents a value less than ulp(a) = 2^(e.a)
::
++ lug
~/ %lug
|= [t=$?($fl $ce $sm $lg $ne $na $nt) a=[e=@s a=@u] s=?] ^- fn
?< =(a.a 0)
=-
?. =(den %f) - :: flush denormals
?. ?=([$f *] -) -
?: =((met 0 ->+>) prc) - [%f & zer]
::
=+ m=(met 0 a.a)
?> |(s (gth m prc)) :: require precision
=+ ^= q %+ max
?: (gth m prc) (^sub m prc) 0 :: reduce precision
%- abs:si ?: =(den %i) --0 :: enforce min. exp
?: =((cmp:si e.a emn) -1) (dif:si emn e.a) --0
=^ b a :- (end 0 q a.a)
a(e (sum:si e.a (sun:si q)), a (rsh 0 q a.a))
::
?~ a.a
?< =(den %i)
?- t
$fl [%f & zer]
$sm [%f & zer]
$ce [%f & spd]
$lg [%f & spd]
$ne ?: s [%f & ?:((lte b (bex (dec q))) zer spd)]
[%f & ?:((^lth b (bex (dec q))) zer spd)]
$nt ?: s [%f & ?:((lte b (bex (dec q))) zer spd)]
[%f & ?:((^lth b (bex (dec q))) zer spd)]
$na [%f & ?:((^lth b (bex (dec q))) zer spd)]
==
::
=. a (xpd a)
::
=. a
?- t
$fl a
$lg a(a +(a.a))
$sm ?. &(=(b 0) s) a
?: &(=(e.a emn) !=(den %i)) a(a (dec a.a))
=+ y=(dec (^mul a.a 2))
?. (lte (met 0 y) prc) a(a (dec a.a))
[(dif:si e.a --1) y]
$ce ?: &(=(b 0) s) a a(a +(a.a))
$ne ?~ b a
=+ y=(bex (dec q))
?: &(=(b y) s) :: round halfs to even
?~ (dis a.a 1) a a(a +(a.a))
?: (^lth b y) a a(a +(a.a))
$na ?~ b a
=+ y=(bex (dec q))
?: (^lth b y) a a(a +(a.a))
$nt ?~ b a
=+ y=(bex (dec q))
?: =(b y) ?: s a a(a +(a.a))
?: (^lth b y) a a(a +(a.a))
==
::
=. a ?. =((met 0 a.a) +(prc)) a
a(a (rsh 0 1 a.a), e (sum:si e.a --1))
?~ a.a [%f & zer]
::
?: =(den %i) [%f & a]
?: =((cmp:si emx e.a) -1) [%i &] [%f & a] :: enforce max. exp
::
++drg:fl
Get printable decimal
Produces the decimal form of a using the Dragon4 algorithm. Guarantees
accurate results for rounded floats.
Accepts
a is a cell of a signed integer and an unsigned integer.
Produces
A cell of a signed integer and an unsigned integer.
Source
++ drg
~/ %drg
|= [a=[e=@s a=@u]] ^- [@s @u]
?< =(a.a 0)
=. a (xpd a)
=+ r=(lsh 0 ?:((syn:si e.a) (abs:si e.a) 0) a.a)
=+ s=(lsh 0 ?.((syn:si e.a) (abs:si e.a) 0) 1)
=+ mn=(lsh 0 ?:((syn:si e.a) (abs:si e.a) 0) 1)
=+ mp=mn
=> ?.
?& =(a.a (bex (dec prc))) :: if next smallest
|(!=(e.a emn) =(den %i)) :: float is half ULP,
== :: tighten lower bound
.
%= .
mp (lsh 0 1 mp)
r (lsh 0 1 r)
s (lsh 0 1 s)
==
=+ [k=--0 q=(^div (^add s 9) 10)]
|- ?: (^lth r q)
%= $
k (dif:si k --1)
r (^mul r 10)
mn (^mul mn 10)
mp (^mul mp 10)
==
|- ?: (gte (^add (^mul r 2) mp) (^mul s 2))
$(s (^mul s 10), k (sum:si k --1))
=+ [u=0 o=0]
|- :: r/s+o = a*10^-k
=+ v=(dvr (^mul r 10) s)
=> %= .
k (dif:si k --1)
u p.v
r q.v
mn (^mul mn 10)
mp (^mul mp 10)
==
=+ l=(^lth (^mul r 2) mn) :: in lower bound
=+ ^= h :: in upper bound
?| (^lth (^mul s 2) mp)
(gth (^mul r 2) (^sub (^mul s 2) mp))
==
?: &(!l !h)
$(o (^add (^mul o 10) u))
=+ q=&(h |(!l (gth (^mul r 2) s)))
=. o (^add (^mul o 10) ?:(q +(u) u))
[k o]
Examples
> (sun:fl 218.116)
[%f s=%.y e=-95 a=8.640.464.947.480.640.129.276.716.135.743.488]
> (^drg:fl [e=-95 a=8.640.464.947.480.640.129.276.716.135.743.488])
[--0 218.116]
> (sun:fl 102.057.673.128.349)
[%f s=%.y e=-66 a=7.530.527.107.827.833.883.675.587.233.447.936]
> (^drg:fl [e=-66 a=7.530.527.107.827.833.883.675.587.233.447.936])
[--0 102.057.673.128.349]++toj:fl
Round to integer
Rounds float a to the nearest decimal float with an exponent of 0.
Accepts
a is a cell of a signed integer and an unsigned integer.
Produces
An fn.
Source
++ toj
|= [a=[e=@s a=@u]] ^- fn
?. =((cmp:si e.a --0) -1) [%f & a]
=+ x=(abs:si e.a)
=+ y=(rsh 0 x a.a)
?: |(=(r %d) =(r %z)) [%f & --0 y]
=+ z=(end 0 x a.a)
?: |(=(r %u) =(r %a)) [%f & --0 ?~(z y +(y))]
=+ i=(bex (dec x))
?: &(=(z i) =((dis y 1) 0)) [%f & --0 y]
?: (^lth z i) [%f & --0 y] [%f & --0 +(y)]
Examples
> (^toj:fl [-11 7.530.107.827.833.587])
[%f s=%.y e=--0 a=3.676.810.462.809]
> (^toj:fl [-11 7.530.107.827.833.589])
[%f s=%.y e=--0 a=3.676.810.462.809]++ned:fl
Require float
Produces a if a is a is of floating-point representation. If a is another
case of fn, such as infinity or not-a-number, a crash is produced.
Accepts
a is an fn.
Produces
A cell of a signed integer and an unsigned integer.
Source
++ ned
|= [a=fn] ^- [$f s=? e=@s a=@u]
?: ?=([$f *] a) a
~_ leaf+"need-float"
!!
Examples
> (ned:fl [%f s=%.y e=-11 a=7.530.107.827.833.587])
[%f s=%.y e=-11 a=7.530.107.827.833.587]
> (ned:fl [%n ~])
! need-float
! exit
> (ned:fl [%i |])
! need-float
! exit++shf:fl
Shift power
Multiplies a by 2 to the b power without rounding. This results in shifting
the exponent term by b.
Accepts
a is an fn.
b is a signed integer.
Produces
An fn.
Source
++ shf
|= [a=fn b=@s]
?: |(?=([$n *] a) ?=([$i *] a)) a
a(e (sum:si e.a b))
Examples
> (shf:fl [[%f & -2 7] --2])
[%f s=%.y e=--0 a=7]
> (shf:fl [[%f & -2 7] -2])
[%f s=%.y e=-4 a=7]
> (shf:fl [%f & -11 7.530.107.827.833.587] --5)
[%f s=%.y e=-6 a=7.530.107.827.833.587]++fli:fl
Flip sign
Produces a with its signed changed from positive to negative, or vice versa.
Accepts
a is an fn.
Produces
An fn.
Source
++ fli
|= [a=fn] ^- fn
?-(-.a $f a(s !s.a), $i a(s !s.a), $n a)
Examples
> (fli:fl [%f %.y -2 7])
[%f s=%.n e=-2 a=7]
> (fli:fl [%f %.n --2 30.617])
[%f s=%.y e=--2 a=30.617]
> (fli:fl [%f | --2 30.617])
[%f s=%.y e=--2 a=30.617]++swr:fl
Switch rounding
Switches the rounding mode of r:fl.
Source
++ swr ?+(r r $d %u, $u %d)
Examples
> r:fl
%n
> swr:fl
%n
> =new-fl fl :: new fl core with changed state
> =new-fl new-fl(r %u)
> swr:new-fl
%d++prc:fl
Force precision of 2 or greater
Produces p, the core's precision, if p is greater than or equal to 2.
Otherwise, a crash is produced.
Source
++ prc ?>((gth p 1) p)
Examples
> prc:fl
113
> =new-fl fl
> =new-fl new-fl(p 1)
> prc:new-fl
! exit
> =new-fl new-fl(p 2)
> prc:new-fl
2++den:fl
Behavior
Produces d:fl. Denormalizes if d:fl is %d. Flushes denormals to zero if
d:fl is %f.
- Denormalizes if
d:flis%d. - Flushes denormals to zero if
d:flis%f. - Infinite exponent range if
$dis$i.
The default value of d is %d.
Source
++ den d
Examples
> den:fl
%d
> =new-fl fl
> =new-fl new-fl(d %f)
> den:new-fl
%f++emn:fl
Minimum exponent
Produces v:fl, the minimum exponent. The default minimum exponent is -16.494.
Source
++ emn v
Examples
> emn:fl
-16.494++emx:fl
Maximum exponent
Returns the maximum exponent of fl. The default maximum exponent is --16.271.
Source
++ emx (sum:si emn (sun:si w))
Examples
> emx:fl
--16.271
> `@u`emx:fl
32.542++spd:fl
Smallest denormal
Produces the smallest possible denormalized float.
Source
++ spd [e=emn a=1]
Examples
> spd:fl
[e=-16.494 a=1]++spn:fl
Smallest normal
Produces the smallest representable normal float.
Source
++ spn [e=emn a=(bex (dec prc))]
Examples
> spn:fl
[e=-16.494 a=5.192.296.858.534.827.628.530.496.329.220.096]++lfn:fl
Largest normal
Produces the largest representable normal float.
Source
++ lfn [e=emx a=(fil 0 prc 1)]
Examples
> lfn:fl
[e=--16.271 a=10.384.593.717.069.655.257.060.992.658.440.191]++lfe:fl
Maximum
Produces the sum of emx:fl plus prc:fl.
Source
++ lfe (sum:si emx (sun:si prc)) :: 2^lfe is > than all
Examples
> lfe:fl
--16.384++zer:fl
Zero
Produces zero represented as a float.
Source
++ zer [e=--0 a=0]
--
|%
Examples
> zer:fl
[e=--0 a=0]++rou:fl
Round
Rounds a. The way in which a is rounded depends on the value of r:fl.
Accepts
a is an fn.
Produes
An fn.
Source
++ rou
|= [a=fn] ^- fn
?. ?=([$f *] a) a
?~ a.a [%f s.a zer]
?: s.a (^rou +>.a)
=.(r swr (fli (^rou +>.a)))
Examples
> =a 10.161.487.211.429.486.882.397.572.894.294.017.777
> (rou:fl [%f & --12 a])
[%f s=%.y e=--22 a=9.923.327.354.911.608.283.591.379.779.584.002]
> (rou:fl [%f & --12 (add a 1)])
[%f s=%.y e=--22 a=9.923.327.354.911.608.283.591.379.779.584.002]
> (rou:fl [%f & --12 (add a 300)])
[%f s=%.y e=--22 a=9.923.327.354.911.608.283.591.379.779.584.002]
> (rou:fl [%f & --12 (add a 1.000)])
[%f s=%.y e=--22 a=9.923.327.354.911.608.283.591.379.779.584.003]++syn:fl
Get sign
Produces the sign of a.
Accepts
a is an fn.
Produes
An fn.
Source
++ syn
|= [a=fn] ^- ?
?-(-.a $f s.a, $i s.a, $n &)
Examples
> (syn:fl (sun:fl 106))
%.y
> (syn:fl [%f | --0 106])
%.n++abs:fl
Absolute value
Produces the absolute value of a.
Accepts
a is an fn.
Produes
An fn.
Sources
++ abs
|= [a=fn] ^- fn
?: ?=([$f *] a) [%f & e.a a.a]
?: ?=([$i *] a) [%i &] [%n ~]
Examples
> (abs:fl [%f | --0 106])
[%f s=%.y e=--0 a=106]
> (abs:fl [%f & --0 106])
[%f s=%.y e=--0 a=106]++add:fl
Add
Produces the sum of a plus b.
Accepts
a is an fn.
b is an fn.
Produces
An fn.
Source
++ add
|= [a=fn b=fn] ^- fn
?: |(?=([$n *] a) ?=([$n *] b)) [%n ~]
?: |(?=([$i *] a) ?=([$i *] b))
?: &(?=([$i *] a) ?=([$i *] b))
?: =(a b) a [%n ~]
?: ?=([$i *] a) a b
?: |(=(a.a 0) =(a.b 0))
?. &(=(a.a 0) =(a.b 0)) %- rou ?~(a.a b a)
[%f ?:(=(r %d) &(s.a s.b) |(s.a s.b)) zer]
%- |= [a=fn]
?. ?=([$f *] a) a
?. =(a.a 0) a
[%f !=(r %d) zer]
?: =(s.a s.b)
?: s.a (^add +>.a +>.b |)
=.(r swr (fli (^add +>.a +>.b |)))
?: s.a (^sub +>.a +>.b |)
(^sub +>.b +>.a |)
Examples
> (add:fl [%f & --0 106] [%f | --3 55])
[%f s=%.n e=-104 a=6.774.324.807.619.657.921.598.381.929.529.344]++ead:fl
Exact add
Produces the exact sum of a plus b.
Accepts
a is an fn.
b is an fn.
Produces
An fn.
Source
++ ead
|= [a=fn b=fn] ^- fn
?: |(?=([$n *] a) ?=([$n *] b)) [%n ~]
?: |(?=([$i *] a) ?=([$i *] b))
?: &(?=([$i *] a) ?=([$i *] b))
?: =(a b) a [%n ~]
?: ?=([$i *] a) a b
?: |(=(a.a 0) =(a.b 0))
?. &(=(a.a 0) =(a.b 0)) ?~(a.a b a)
[%f ?:(=(r %d) &(s.a s.b) |(s.a s.b)) zer]
%- |= [a=fn]
?. ?=([$f *] a) a
?. =(a.a 0) a
[%f !=(r %d) zer]
?: =(s.a s.b)
?: s.a (^add +>.a +>.b &)
(fli (^add +>.a +>.b &))
?: s.a (^sub +>.a +>.b &)
(^sub +>.b +>.a &)
::
Examples
> (ead:fl [%f & --0 106] [%f | --3 55])
[%f s=%.n e=--0 a=334]++sub:fl
Subtract
Produces the difference of a minus b.
Accepts
a is an fn.
b is an fn.
Produces
An fn.
Source
++ sub
|= [a=fn b=fn] ^- fn (add a (fli b))
Examples
> (sub:fl [%f & --13 2.718] [%f & --23 11])
[%f s=%.n e=-86 a=5.416.671.014.775.224.232.595.412.796.571.648]++mul:fl
Multiply
Produces the product of a multiplied by b.
Accepts
a is an fn.
b is an fn.
Produces
An fn.
Source
++ mul
|= [a=fn b=fn] ^- fn
?: |(?=([$n *] a) ?=([$n *] b)) [%n ~]
?: ?=([$i *] a)
?: ?=([$i *] b)
[%i =(s.a s.b)]
?: =(a.b 0) [%n ~] [%i =(s.a s.b)]
?: ?=([$i *] b)
?: =(a.a 0) [%n ~] [%i =(s.a s.b)]
?: |(=(a.a 0) =(a.b 0)) [%f =(s.a s.b) zer]
?: =(s.a s.b) (^mul +>.a +>.b)
=.(r swr (fli (^mul +>.a +>.b)))
++emu:fl
Exact multiply
Produces the exact product of a multiplied by b.
Accepts
a is an fn.
b is an fn.
Produces
An fn.
Examples
++ emu
|= [a=fn b=fn] ^- fn
?: |(?=([$n *] a) ?=([$n *] b)) [%n ~]
?: ?=([$i *] a)
?: ?=([$i *] b)
[%i =(s.a s.b)]
?: =(a.b 0) [%n ~] [%i =(s.a s.b)]
?: ?=([$i *] b)
?: =(a.a 0) [%n ~] [%i =(s.a s.b)]
?: |(=(a.a 0) =(a.b 0)) [%f =(s.a s.b) zer]
[%f =(s.a s.b) (sum:si e.a e.b) (^^mul a.a a.b)]++div:fl
Divide
Produces the quotient of a divided by b.
Accepts
a is an fn.
b is an fn.
Produces
An fn.
Divide
++ div
|= [a=fn b=fn] ^- fn
?: |(?=([$n *] a) ?=([$n *] b)) [%n ~]
?: ?=([$i *] a)
?: ?=([$i *] b) [%n ~] [%i =(s.a s.b)]
?: ?=([$i *] b) [%f =(s.a s.b) zer]
?: =(a.a 0) ?: =(a.b 0) [%n ~] [%f =(s.a s.b) zer]
?: =(a.b 0) [%i =(s.a s.b)]
?: =(s.a s.b) (^div +>.a +>.b)
=.(r swr (fli (^div +>.a +>.b)))
++fma:fl
Fused multiply-add
Produces the sum of c plus the product of a multiplied by b;
(a * b) + c.
Accepts
a is an fn.
b is an fn.
c is an fn.
Produces
An fn.
Source
++ fma
|= [a=fn b=fn c=fn] ^- fn
(add (emu a b) c)
Examples
> (fma:fl [%f & --13 2.718] [%f & --23 11] [%f & --13 2.718])
[%f s=%.y e=-62 a=9.475.054.514.089.037.465.004.673.635.188.736]=++sqt:fl
Square root
Produces the square root of a.
Accepts
a is an fn.
Produces
An fn.
Source
++ sqt
|= [a=fn] ^- fn
?: ?=([$n *] a) [%n ~]
?: ?=([$i *] a) ?:(s.a a [%n ~])
?~ a.a [%f s.a zer]
?: s.a (^sqt +>.a) [%n ~]
Examples
> (sqt:fl [%f s=%.y e=-18 a=342.602.577])
[%f s=%.y e=-107 a=5.865.903.143.604.945.574.132.671.852.050.553]++inv:fl
Inverse
Produces the inverse of a by dividing 1 by a.
Accepts
a is an fn.
Produces
An fn.
Source
++ inv
|= [a=fn] ^- fn
(div [%f & --0 1] a)
Examples
> (inv:fl [%f s=%.y e=--0 a=10])
[%f s=%.y e=-116 a=8.307.674.973.655.724.205.648.794.126.752.154]
> (drg:fl [%f s=%.y e=-116 a=8.307.674.973.655.724.205.648.794.126.752.154])
[%d s=%.y e=-1 a=1]
> (inv:fl [%f s=%.y e=--1 a=10])
[%f s=%.y e=-117 a=8.307.674.973.655.724.205.648.794.126.752.154]
> (drg:fl [%f s=%.y e=-117 a=8.307.674.973.655.724.205.648.794.126.752.154])
[%d s=%.y e=-2 a=5]
> (inv:fl [%f s=%.y e=--2 a=10])
[%f s=%.y e=-118 a=8.307.674.973.655.724.205.648.794.126.752.154]
> (drg:fl [%f s=%.y e=-118 a=8.307.674.973.655.724.205.648.794.126.752.154])
[%d s=%.y e=-3 a=25]++sun:fl
Signed integer to float
Produces a in floating-point representation.
Accepts
a is an unsigned integer.
Produces
An fn.
Source
++ sun
|= [a=@u] ^- fn
(rou [%f & --0 a])
Examples
> (sun:fl 0)
[%f s=%.y e=--0 a=0]
> (sun:fl 5.048.729)
[%f s=%.y e=-90 a=6.250.023.776.601.238.669.911.180.544.311.296]
> (sun:fl -100)
! exit++san:fl
Signed integer to float
Produces the floating-point representation of a, an unsigned integer.
Accepts
a is an unsigned integer.
Produces
An fn.
Source
++ san
|= [a=@s] ^- fn
=+ b=(old:si a)
(rou [%f -.b --0 +.b])
Examples
> (san:fl --100)
[%f s=%.y e=-106 a=8.112.963.841.460.668.169.578.900.514.406.400]
> (san:fl -100)
[%f s=%.n e=-106 a=8.112.963.841.460.668.169.578.900.514.406.400]++lth:fl
Less than
Tests if a is less than b. Returns ~ in the event of a or b being a
NaN ([%n ~]).
Accepts
a is an fn.
b is an fn.
Produces
A unit of flag.
Source
++ lth
|= [a=fn b=fn] ^- (unit ?)
?: |(?=([$n *] a) ?=([$n *] b)) ~ :- ~
?: =(a b) |
?: ?=([$i *] a) !s.a ?: ?=([$i *] b) s.b
?: |(=(a.a 0) =(a.b 0))
?: &(=(a.a 0) =(a.b 0)) |
?: =(a.a 0) s.b !s.a
?: !=(s.a s.b) s.b
?: s.a (^lth +>.a +>.b) (^lth +>.b +>.a)
Examples
> (lth:fl (sun:fl 116) (sun:fl 4.820))
[~ u=%.y]
> (lth:fl (sun:fl 218.116) (sun:fl 4.820))
[~ u=%.n]
> (lth:fl (sun:fl 218.116) [%n ~])
~++lte:fl
Less than or equal
Tests whether a is less than or equal to b. Returns ~ in the event of a
or b being a NaN ([%n ~]).
Accepts
a is an fn.
b is an fn.
Produces
A unit of flag.
Source
++ lte
|= [a=fn b=fn] ^- (unit ?)
%+ bind (lth b a) |= a=? !a
Examples
> (lte:fl (sun:fl 102) [%f %.y -5 973.655.724])
[~ u=%.y]
> (lte:fl (sun:fl 102) [%f %.y -24 973.655.724])
[~ u=%.n]
> (lte:fl [%f %.y --2 25] (sun:fl 100))
[~ u=%.y]
> (lte:fl [%f %.y --2 25] [%f %.y --3 2])
[~ u=%.n]
> (lte:fl [%f %.y --2 25] [%n ~])
~++equ:fl
Equals
Tests if a is equal to b. Returns ~ in the event of a or b being a NaN
([%n ~]).
Accepts
a is an fn.
b is an fn.
Produces
An unit of flag.
Source
++ equ
|= [a=fn b=fn] ^- (unit ?)
?: |(?=([$n *] a) ?=([$n *] b)) ~ :- ~
?: =(a b) &
?: |(?=([$i *] a) ?=([$i *] b)) |
?: |(=(a.a 0) =(a.b 0))
?: &(=(a.a 0) =(a.b 0)) & |
?: |(=(e.a e.b) !=(s.a s.b)) |
(^equ +>.a +>.b)
Examples
> (equ:fl [%f %.y --2 25] (sun:fl 100))
[~ u=%.y]
> (equ:fl [%f %.y --2 25] (sun:fl 101))
[~ u=%.n]++gte:fl
Greater or equal than
Tests whether a is greater than or equal to b. Returns ~ in the event of
a or b being a NaN ([%n ~]).
Accepts
a is an fn.
b is an fn.
Produces
An unit of flag.
Source
++ gte
|= [a=fn b=fn] ^- (unit ?) (lte b a)
Examples
> (gte:fl [%f %.y --2 25] (sun:fl 100))
[~ u=%.y]
> (gth:fl [%f %.y --6 73.989] [%f %.y --5 919.599])
[~ u=%.n]
> (gth:fl [%f %.y --6 73.989] [%n ~])
~++gth:fl
Greater than
Tests whether a is greater than b. Returns ~ in the event of a or b
being a NaN ([%n ~]).
Accepts
a is an fn.
b is an fn.
Produces
An unit of flag.
Source
++ gth
|= [a=fn b=fn] ^- (unit ?) (lth b a)
Examples
> (gth:fl [%f %.y --2 25] (sun:fl 100))
[~ u=%.n]
> (gth:fl [%f %.y --6 73.989] [%f %.y --5 119.599])
[~ u=%.y]++drg:fl
Float to decimal
Produces the decimal form of a using the Dragon4 algorithm. Guarantees
accurate results for rounded floats.
Accepts
a is an fn.
Produces
A dn.
Source
++ drg
|= [a=fn] ^- dn
?: ?=([$n *] a) [%n ~]
?: ?=([$i *] a) [%i s.a]
?~ a.a [%d s.a --0 0]
[%d s.a (^drg +>.a)]
Examples
> (drg:fl [%f | --6 73.989])
[%d s=%.n e=--0 a=4.735.296]++grd:fl
Decimal to float
Converts decimal a to fn.
Accepts
a is a dn.
Produces
An fn.
Source
++ grd
|= [a=dn] ^- fn
?: ?=([$n *] a) [%n ~]
?: ?=([$i *] a) [%i s.a]
=> .(r %n)
=+ q=(abs:si e.a)
?: (syn:si e.a)
(mul [%f s.a --0 a.a] [%f & e.a (pow 5 q)])
(div [%f s.a --0 a.a] [%f & (sun:si q) (pow 5 q)])
Examples
> (grd:fl [%d s=%.n e=--0 a=73.989])
[%f s=%.n e=-96 a=5.862.012.516.267.904.074.208.723.341.410.304]
> (grd:fl [%d s=%.n e=--0 a=100])
[%f s=%.n e=-106 a=8.112.963.841.460.668.169.578.900.514.406.400]++toi:fl
Round to signed integer
Rounds a to the nearest signed integer.
Accepts
a is an fn.
Produces
A unit of @s.
Source
++ toi
|= [a=fn] ^- (unit @s)
=+ b=(toj a)
?. ?=([$f *] b) ~ :- ~
=+ c=(^^mul (bex (abs:si e.b)) a.b)
(new:si s.b c)
Examples
> (toi:fl [%f s=%.y e=-78 a=8.112.963.841.460.668.169.578.900.514.406.400])
[~ u=--26.843.545.600]++toj:fl
Round to integer fn
Rounds a to the nearest decimal integer.
Accepts
a is an fn.
Produces
A unit of @s.
Source
++ toj
|= [a=fn] ^- fn
?. ?=([$f *] a) a
?~ a.a [%f s.a zer]
?: s.a (^toj +>.a)
=.(r swr (fli (^toj +>.a)))
--
Examples
> (toj:fl [%f s=%.y e=-78 a=8.112.963.841.460.668.169.578.900.514.406.400])
[%f s=%.y e=--0 a=26.843.545.600]
> (toj:fl [%f s=%.y e=-78 a=8.112.963.841.460.668.169.578.900.514])
[%f s=%.y e=--0 a=26.844]
> (toj:fl [%f s=%.y e=-78 a=8.112.963.841.460])
[%f s=%.y e=--0 a=0]
> (toj:fl [%f s=%.y e=-9 a=9.002])
[%f s=%.y e=--0 a=16]++ff
IEEE-754 Formatting
Container core for IEEE-754 formatting operations.
wis width: The number of bits in the exponent field.pis precision: The number of bits in the significand field.wis bias: Added to exponent when storing.ris rounding mode: Possible modes are nearest ($n), up ($u), down ($d), to zero ($z), and away from zero ($a). Default value is%a.
Source
++ ff
|_ [[w=@u p=@u b=@s] r=$?($n $u $d $z $a)]
Examples
> =ffcore ~(. ff [8 8 0] %n)
> ffcore
<24.ltg {{{@ud @ud @ud} r/$n} <54.tyv 119.wim 31.ohr 1.jmk $143>}>
>Discussion
++ff has no use outside of the functionality provided to other cores: ++rd,
++rs, ++rq, and ++rh. It's not intended to be used directly; it's just
meant to power those cores.
++sb:ff
Sign bit
Produces the sign bit of ++ff.
Source
++ sb (bex (^add w p))
Examples
> sb:ff
1++me:ff
Minimum exponent
Produces the minimum possible exponent of ff.
Source
++ me (dif:si (dif:si --1 b) (sun:si p))
Examples
> me:ff
--1++pa:ff
Initialize fl
Instantiates the core fl, giving values to its samples based on the
configuration of the ff core.
Source
++ pa
%*(. fl p +(p), v me, w (^sub (bex w) 3), d %d, r r)
Examples
> ~(pa ff [11 52 --1.023] %n)
< 23.qzd
28.btz
{ {{p/@ v/@s w/@} r/?($n $u $a $d $z) d/$d}
<54.tyv 119.wim 31.ohr 1.jmk $143>
}
>Discussion
++pa exists exclusively for internal use of ++ff, and ++ff exists for
internal use in other cores.
++sea:ff
@r to fn
Converts a from @r to fn.
Accepts
a is a @r, an IEEE float.
Produces
A unit of @s.
Source
++ sea
|= [a=@r] ^- fn
=+ [f=(cut 0 [0 p] a) e=(cut 0 [p w] a)]
=+ s=(sig a)
?: =(e 0)
?: =(f 0) [%f s --0 0] [%f s me f]
?: =(e (fil 0 w 1))
?: =(f 0) [%i s] [%n ~]
=+ q=:(sum:si (sun:si e) me -1)
=+ r=(^add f (bex p))
[%f s q r]
Examples
> (sea:ff `@r`0x8)
[%f s=%.y e=--0 a=0]++bit:ff
fn to @r, rounding
Converts a from fn to @r and applies rounding.
Accepts
a is an fn.
Produces
A @r.
Source
++ bit |= [a=fn] (bif (rou:pa a))
Examples
> (bit:ma:rd [%f | -6 202])
0xc009400000000000++bif:ff
fn to @r, no rounding
Converts a from fn to @r. No rounding is applied.
Accepts
a is a @r, an IEEE float.
Produces
A flag.
Source
++ bif
|= [a=fn] ^- @r
?: ?=([$i *] a)
=+ q=(lsh 0 p (fil 0 w 1))
?: s.a q (^add q sb)
?: ?=([$n *] a) (lsh 0 (dec p) (fil 0 +(w) 1))
?~ a.a ?: s.a `@r`0 sb
=+ ma=(met 0 a.a)
?. =(ma +(p))
?> =(e.a me)
?> (^lth ma +(p))
?: s.a `@r`a.a (^add a.a sb)
=+ q=(sum:si (dif:si e.a me) --1)
=+ r=(^add (lsh 0 p (abs:si q)) (end 0 p a.a))
?: s.a r (^add r sb)
Examples
> (bif:ma:rd *fn)
0x7ff8000000000000++sig:ff
Get sign
Produces the sign of a.
Accepts
a is a @r, an IEEE float.
Produces
A flag.
Source
++ sig
|= [a=@r] ^- ?
=(0 (cut 0 [(^add p w) 1] a))
Examples
> (sig:ff `@r`5)
%.n++exp:ff
Get exponent
Produces the exponent of a.
Accepts
a is a @r, an IEEE float.
Produces
A signed integer.
Source
++ exp
|= [a=@r] ^- @s
(dif:si (sun:si (cut 0 [p w] a)) b)
Examples
> (exp:ff `@r`5)
--0++add:ff
Add
Produces the sum of a plus b.
Accepts
a is a @r, an IEEE float.
b is a @r, an IEEE float.
Produces
A @r, an IEEE float.
Source
++ add
|= [a=@r b=@r]
(bif (add:pa (sea a) (sea b)))
Examples
> (add:ma:rd `@r`5 `@r`11)
0x10++sub:ff
Sub
Produces the sum of a plus b.
Accepts
a is a @r, an IEEE float.
b is a @r, an IEEE float.
Produces
A @r, an IEEE float.
Source
++ sub
|= [a=@r b=@r]
(bif (sub:pa (sea a) (sea b)))
Examples
> (sub:ma:rd `@r`5 `@r`11)
0x8000000000000006++mul:ff
Multiply
Produces the product of a multiplied by b.
Accepts
a is a @r, an IEEE float.
b is a @r, an IEEE float.
Produces
A @r, an IEEE float.
Multiply
++ mul
|= [a=@r b=@r]
(bif (mul:pa (sea a) (sea b)))
Examples
> (mul:ma:rd `@r`11 `@r`2)
0x0++div:ff
Divide
Produces the quotient of a divided by b.
Accepts
a is a @r, an IEEE float.
b is a @r, an IEEE float.
Produces
A @r, an IEEE float.
Source
++ div
|= [a=@r b=@r]
(bif (div:pa (sea a) (sea b)))
Examples
> (div:ma:rd `@r`175 `@r`26)
0x401aec4ec4ec4ec4++fma:ff
Fused multiply-add
Produces the sum of c plus the product of a multiplied by b;
(a * b) + c.
Accepts
a is a @r, an IEEE float.
b is a @r, an IEEE float.
c is a @r, an IEEE float.
Produces
A @r, an IEEE float.
Source
++ fma
|= [a=@r b=@r c=@r]
(bif (fma:pa (sea a) (sea b) (sea c)))
Examples
> (fma:ma:rd `@r`175 `@r`26 `@r`100)
0x64++sqt:ff
Square root
Produces the square root of a.
Accepts
a is a @r, an IEEE float.
Produces
A @r, an IEEE float.
Source
++ sqt
|= [a=@r]
(bif (sqt:pa (sea a)))
Examples
> (sqt:ma:rd `@r`175)
0x1e9a751f9447b724++lth:ff
Less than
Tests whether a is less than b.
Accepts
a is a @r, an IEEE float.
b is a @r, an IEEE float.
Produces
A flag.
Source
++ lth
|= [a=@r b=@r] (fall (lth:pa (sea a) (sea b)) |)
Examples
> (lth:ma:rd `@rd`1 `@rd`2)
%.y
> (lth:ma:rd `@rd`10 `@rd`2)
%.n++lte:ff
Less than or equal to
Tests whether a is less than or equal to b.
Accepts
a is a @r, an IEEE float.
b is a @r, an IEEE float.
Produces
A flag.
Source
++ lte
|= [a=@r b=@r] (fall (lte:pa (sea a) (sea b)) |)
Examples
> (lte:ma:rd `@rd`10 `@rd`2)
%.n
> (lte:ma:rd `@rd`10 `@rd`10)
%.y++equ:ff
Equals
Tests whether a is equal to b.
Accepts
a is a @r, an IEEE float.
b is a @r, an IEEE float.
Produces
A flag.
Source
++ equ
|= [a=@r b=@r] (fall (equ:pa (sea a) (sea b)) |)
Examples
> (equ:ma:rd `@rd`10 `@rd`2)
%.n
> (equ:ma:rd `@rd`10 `@rd`10)
%.y++gte:ff
Greater or equal than
Tests whether a is greater than or equal to b.
Accepts
a is a @r, an IEEE float.
b is a @r, an IEEE float.
Produces
A flag.
Source
++ gte
|= [a=@r b=@r] (fall (gte:pa (sea a) (sea b)) |)
Examples
> (gte:ma:rd `@rd`10 `@rd`10)
%.y
> (gte:ma:rd `@rd`10 `@rd`11)
%.n++gth:ff
Greater than
Tests whether a is greater than or equal to b.
Accepts
a is a @r, an IEEE float.
b is a @r, an IEEE float.
Produces
A flag.
Source
++ gth
|= [a=@r b=@r] (fall (gth:pa (sea a) (sea b)) |)
Examples
> (gth:ma:rd `@rd`10 `@rd`10)
%.n
> (gth:ma:rd `@rd`10 `@rd`9)
%.y++sun:ff
Unsigned integer to @r
Converts a from an unsigned integer (@u) to @r.
Accepts
a is @u, unsigned integer.
Produces
A @r, an IEEE float.
Source
++ sun
|= [a=@u] (bit [%f & --0 a])
Examples
> (sun:ma:rd 658.149.282)
0x41c39d47d1000000++san:ff
Signed integer to @r
Converts a from a signed integer to @r.
Accepts
a is @s, an unsigned integer
Produces
A @r, an IEEE float.
Source
++ san
|= [a=@s] (bit [%f (syn:si a) --0 (abs:si a)])
Examples
> (san:ma:rd --10)
0x4024000000000000++toi:ff
Round to integer
Rounds a to the nearest signed integer.
Accepts
a is a @r, an IEEE float.
Produces
A flag of @s.
Source
++ toi
|= [a=@r] (toi:pa (sea a))
Examples
> (toi:ma:rd `@r`0x4af)
[~ u=--0]++drg:ff
@r to decimal float
Converts a from @r to dn using the Dragon4 algorithm.
Accepts
a is a @r, an IEEE float.
Produces
A dn.
Source
++ drg
|= [a=@r] (drg:pa (sea a))
Examples
> (drg:ma:rd `@r`0x41c0)
[%d s=%.y e=-323 a=8.316]
> (drg:ma:rd (sun:ma:rd 658.149.282))
[%d s=%.y e=--0 a=658.149.282]++grd:ff
Decimal float to @r
Converts a from dn to @r.
Accepts
a is a dn.
Produces
A @r, an IEEE float.
Source
++ grd
|= [a=dn] (bif (grd:pa a))
--
Examples
> (grd:ma:rd [%d s=%.y e=--0 a=658.149.282])
0x41c39d47d1000000++rlyd
Prep @rd for print
Converts a from a double-precision binary float to decimal64.
Accepts
a is a @rd, a double-precision float.
Produces
A dn.
Source
++ rlyd |= a=@rd ^- dn (drg:rd a)
Examples
> (rlyd .~2.4703e-320)
[%d s=%.y e=-324 a=24.703]++rlys
Prep @rs for print
Converts a from a single-precision binary float to decimal32.
Accepts
a is a @rs, a single-precision float.
Produces
A dn.
Source
++ rlys |= a=@rs ^- dn (drg:rs a)
Examples
> (rlys .1.681557e-39)
[%d s=%.y e=-45 a=1.681.557]++rlyh
Prep @rh for print
Converts a from a half-precision binary float to decimal16.
Accepts
a is a @rh, a half-precision float.
Produces
A dn.
Source
++ rlyh |= a=@rh ^- dn (drg:rh a)
Examples
> (rlyh .~~3e1)
[%d s=%.y e=--1 a=3]++rlyq
Prep @rq for print
Converts a from a quad-precision binary float to decimal128.
Accepts
a is a @rq, a quad-precision float.
Produces
A dn.
Source
++ rlyq |= a=@rq ^- dn (drg:rq a)
Examples
> (rlyq .~~~2.2628017865927756787440310766086816e-4343)
[%d s=%.y e=-4.377 a=22.628.017.865.927.756.787.440.310.766.086.816]++ryld
Finish parsing @rd
Converts a from a decimal float to a double-precision binary float.
Accepts
a is a dn.
Produces
A a @rd, a double-precision float.
Source
++ ryld |= a=dn ^- @rd (grd:rd a)
Examples
> (ryld [%d s=%.y e=-324 a=24.703])
.~2.4703e-320++ryls
Finish parsing @rs
Converts a from a decimal float to a single-precision binary float.
Accepts
a is a dn.
Produces
A a @rs, a single-precision float.
Source
++ ryls |= a=dn ^- @rs (grd:rs a)
Examples
> (ryls [%d s=%.y e=-324 a=24.703])
.0
> (ryls [%d s=%.y e=-32 a=24.703])
.2.4703e-28++rylh
Finish parsing @rh
Converts a from a decimal float to a half-precision binary float.
Accepts
a is a dn.
Produces
A a @rh, a half-precision float.
Source
++ rylh |= a=dn ^- @rh (grd:rh a)
Examples
> (rylh [%d s=%.y e=--1 a=703])
.~~7.032e3
> (rylh [%d s=%.y e=--3 a=56])
.~~5.6e4
> (rylh [%d s=%.y e=--4 a=56])
.~~inf++rylq
Finish parsing @rq
Converts a from a decimal float to a quad-precision binary float.
Accepts
a is a dn.
Produces
A a @rq, a quad-precision float.
Source
++ rylq |= a=dn ^- @rq (grd:rq a)
Examples
> (rylq [%d s=%.y e=-324 a=24.703])
.~~~2.4703e-320++rd
Double-precision fp
A container core for operations related to double-precision binary floats.
++rd has four rounding modes: round to nearest ($n), round up ($u), round
down ($d), and round to zero ($z).
Source
++ rd
^?
~% %rd +> ~
|_ r=$?($n $u $d $z)
++ma:rd
Initialize ff
Instantiates the core ff, giving values to its samples based on the
configuration of the rd core.
Source
++ ma
%*(. ff w 11, p 52, b --1.023, r r)
Examples
> ~(ma rd %n)
< 24.ltg
{{{w/@ud p/@ud b/@sd} r/?($n $u $d $z)} <54.tyv 119.wim 31.ohr 1.jmk $143>}
>++sea:rd
@rd to fn
Converts a from a double-precision binary float to fn.
++ sea :: @rd to fn
|= [a=@rd] (sea:ma a)
Examples
> (sea:rd .~4.94066e-319)
[%f s=%.y e=-1.074 a=100.000]++bit:rd
fn to @rd
Converts a from fn to a double-precision binary float.
Accepts
a is an fn.
Produces
A @rd, a double-precision float.
Source
++ bit
|= [a=fn] ^- @rd (bit:ma a)
Examples
> (bit:rd [%f s=%.y e=-1.074 a=100.000])
.~4.94066e-319++add:rd
Add
Produces the sum of a plus b.
Accepts
a is a @rd, a double-precision float.
b is a @rd, a double-precision float.
Produces
A @rd.
Source
++ add ~/ %add
|= [a=@rd b=@rd] ^- @rd
~_ leaf+"rd-fail"
(add:ma a b)
Examples
> (add:rd .~3.94066e12 .~9.2846e11)
.~4.86912e12++sub:rd
Subtract
Produces the difference of a minus b.
Accepts
a is a @rd, a double-precision float.
b is a @rd, a double-precision float.
Produces
A @rd.
Source
++ sub ~/ %sub
|= [a=@rd b=@rd] ^- @rd
~_ leaf+"rd-fail"
(sub:ma a b)
Examples
> (sub:rd .~7.94069e2 .~1.2846e3)
.~-4.9053099999999995e2++mul:rd
Multiply
Produces the product of a times b.
Accepts
a is a @rd, a double-precision float.
b is a @rd, a double-precision float.
Produces
A @rd.
Source
++ mul ~/ %mul
|= [a=@rd b=@rd] ^- @rd
~_ leaf+"rd-fail"
(mul:ma a b)
Examples
> (mul:rd .~7.94069e2 .~1.2246e3)
.~9.724168973999998e5++div:rd
Divide
Produces the quotient of a divided by b.
Accepts
a is a @rd, a double-precision float.
b is a @rd.
Produces
A @rd.
Source
++ div ~/ %div
|= [a=@rd b=@rd] ^- @rd
~_ leaf+"rd-fail"
(div:ma a b)
Examples
> (div:rd .~7.94099e2 .~1.2246e3)
.~6.484558223093255e-1++fma:rd
Fused multiply-add
Produces the sum of c plus the product of a multiplied by b;
(a * b) + c.
Accepts
a is a @rd, an IEEE float.
b is a @rd.
c is a @rd.
Produces
A @rd.
Source
Source
++ fma ~/ %fma
|= [a=@rd b=@rd c=@rd] ^- @rd
~_ leaf+"rd-fail"
(fma:ma a b c)
Examples
> (fma:rd .~7.94099e2 .~1.2246e3 .~3.94066e3)
.~9.763942954e5++sqt:rd
Square root
Produces the square root of a.
Accepts
a is a @rd, a double-precision float.
Produces
A @rd.
Source
++ sqt ~/ %sqt
|= [a=@rd] ^- @rd ~_ leaf+"rd-fail"
(sqt:ma a)
Examples
> (sqt:rd .~3.94066e3)
.~6.2774676422901614e1++lth:rd
Less than
Test whether a is less than b.
Accepts
a is a @rd, a double-precision float.
b is a @rd, a double-precision float.
Produces
A @rd.
Source
++ lth ~/ %lth
|= [a=@rd b=@rd]
~_ leaf+"rd-fail"
(lth:ma a b)
Examples
> (lth:rd .~7.94099e2 .~1.2246e3)
%.y
> (lth:rd .~7.94099e2 .~1.2246e2)
%.n
> (lth:rd .~1.2246e2 .~1.2246e2)
%.n++lte:rd
Less than or equal
Test whether a is less than or equal to b.
Accepts
a is a @rd, a double-precision float.
b is a @rd, a double-precision float.
Produces
A @rd.
Source
++ lte ~/ %lte :: less-equals
|= [a=@rd b=@rd]
~_ leaf+"rd-fail"
(lte:ma a b)
Examples
> (lte:rd .~7.94099e2 .~1.2246e3)
%.y
> (lte:rd .~7.94099e2 .~1.2246e2)
%.n
> (lte:rd .~1.2246e2 .~1.2246e2)
%.y++equ:rd
Equals
Test whether a is equal to b.
Accepts
a is a @rd, a double-precision float.
b is a @rd, a double-precision float.
Produces
A @rd.
Source
++ equ ~/ %equ
|= [a=@rd b=@rd]
~_ leaf+"rd-fail"
(equ:ma a b)
Examples
> (equ:rd .~7.94099e2 .~1.2246e3)
%.n
> (equ:rd .~7.94099e2 .~1.2246e2)
%.n
> (equ:rd .~1.2246e2 .~1.2246e2)
%.y++gte:rd
Greater than or equal
Test whether a is greater than or equal to b.
Accepts
a is a @rd, a double-precision float.
b is a @rd, a double-precision float.
Produces
A @rd.
Source
++ gte ~/ %gte
|= [a=@rd b=@rd]
~_ leaf+"rd-fail"
(gte:ma a b)
Examples
> (gte:rd .~7.94099e2 .~1.2246e3)
%.n
> (gte:rd .~7.94099e2 .~1.2246e2)
%.y
> (gte:rd .~1.2246e2 .~1.2246e2)
%.y++gth:rd
Greater than
Test whether a is greater b.
Accepts
a is a @rd, a double-precision float.
b is a @rd, a double-precision float.
Produces
A @rd.
Source
++ gth ~/ %gth
|= [a=@rd b=@rd]
~_ leaf+"rd-fail"
(gth:ma a b)
Examples
> (gth:rd .~7.94099e2 .~1.2246e3)
%.n
> (gth:rd .~7.94099e2 .~1.2246e2)
%.y
> (gth:rd .~1.2246e2 .~1.2246e2)
%.n++sun:rd
Unsigned integer to @rd
Converts an unsigned integer a to @rd.
Accepts
a is a @u, an unsigned integer.
Produces
A @rd.
Source
++ sun |= [a=@u] ^- @rd (sun:ma a)
Examples
> (sun:rd 511)
.~5.11e2++san:rd
Unsigned integer to @rd
Converts a signed integer a to @rd.
Accepts
a is a @s, a signed integer.
Produces
A @rd.
Source
++ san |= [a=@s] ^- @rd (san:ma a)
Examples
> (san:rd -511)
.~-5.11e2++sig:rd
Get sign
Produces the sign of a.
Accepts
a is a @rd
Produces
A flag.
Source
++ sig |= [a=@rd] ^- ? (sig:ma a)
Examples
> (sig:rd .~1.2246e3)
%.y++exp:rd
Get exponent
Produces the exponent of a.
Accepts
a is a @rd
Produces
A @s.
Source
++ exp |= [a=@rd] ^- @s (exp:ma a) :: get exponent
Examples
> (exp:rd .~1.2246e3)
--10++toi:rd
Round to integer
Rounds a to the nearest integer.
Accepts
a is a @rd
Produces
A unit of @s.
Source
++ toi |= [a=@rd] ^- (unit @s) (toi:ma a)
Examples
> (toi:rd .~1.2246e3)
[~ u=--1.224]++drg:rd
@rd to decimal float
Produces the decimal form of a using the Dragon4 algorithm. Guarantees
accurate results for rounded floats.
Accepts
a is a @rd
Produces
A dn.
Source
++ drg |= [a=@rd] ^- dn (drg:ma a)
Examples
> (drg:rd .~1.2246e3)
[%d s=%.y e=-1 a=12.246]++grd:rd
Decimal float to @rd
Converts a from decimal float to @rd.
Accepts
a is a @dn
Produces
A @rd.
Source
++ grd |= [a=dn] ^- @rd (grd:ma a) :: decimal float to @rd
--
Examples
> (grd:rd [%d s=%.y e=-1 a=12.246])
.~1.2246e3++rs
Single-precision fp
A container core for operations related to single-precision binary floats.
++rs has four rounding modes: round to nearest ($n), round up ($u), round
down ($d), and round to zero ($z).
Source
++ rs
~% %rs +> ~
^?
|_ r=$?($n $u $d $z)
++ma:rs
Initialize ff
Instantiates the core ff, giving values to its samples based on the
configuration of the rs core.
Source
++ ma
%*(. ff w 8, p 23, b --127, r r)
Examples
> ~(ma rs %n)
< 24.ltg
{{{w/@ud p/@ud b/@sd} r/?($n $u $d $z)} <54.tyv 119.wim 31.ohr 1.jmk $143>}
>++sea:rs
@rs to fn
Converts a from @rs to fn.
Accepts
a is a @rs, an single-precision float.
Produces
An fn.
Source
++ sea
|= [a=@rs] (sea:ma a)
Examples
> (sea:rs .1.4e-43)
[%f s=%.y e=-149 a=100]++bit:rs
fn to @rs
Converts a from fn to @rs.
Accepts
a is an fn.
Produces
A @rs, a single-precision float.
Source
++ bit
|= [a=fn] ^- @rs (bit:ma a)
Examples
> (bit:rs [%f & -2 1.000])
.2.5e2++add:rs
Add
Produces the sum of a plus b.
Accepts
a is a @rs, a single-precision float.
b is a @rs.
Produces
A @rs.
Source
++ add ~/ %add
|= [a=@rs b=@rs] ^- @rs
~_ leaf+"rs-fail"
(add:ma a b)
Examples
> (add:rs .2.5e1 .2.5e2)
.2.75e2++sub:rs
Subtract
Subtracts a from b.
Source
++ sub ~/ %sub
|= [a=@rs b=@rs] ^- @rs
~_ leaf+"rs-fail"
(sub:ma a b)
Examples
> (sub:rs .2.5e1 .2.5e2)
.-2.25e2++mul:rs
Multiply
Produces the product of a multiplied by b.
Accepts
a is a @rs, a single-precision float.
b is a @rs.
Produces
A @rs.
Source
++ mul ~/ %mul
|= [a=@rs b=@rs] ^- @rs
~_ leaf+"rs-fail"
(mul:ma a b)
Examples
> (mul:rs .2.5e1 .2.5e2)
.6.25e3++div:rs
Divide
Produces the quotient of a divided by b.
Accepts
a is a @rs, a single-precision float.
b is a @rs.
Produces
A @rs.
Source
++ div ~/ %div
|= [a=@rs b=@rs] ^- @rs
~_ leaf+"rs-fail"
(div:ma a b)
Examples
> (div:rs .4.5e1 .2.2e2)
.2.0454545e-1++fma:rs
Fused multiply-add
Produces the sum of c plus the product of a multiplied by b;
(a * b) + c.
Accepts
a is a @rs, a single-precision float.
b is a @rs.
c is a @rs.
Produces
A @rs.
Source
++ fma ~/ %fma
|= [a=@rs b=@rs c=@rs] ^- @rs
~_ leaf+"rs-fail"
(fma:ma a b c)
Examples
> (fma:rs .2.5e1 .2.5e2 .8.2e1)
.6.332e3++sqt:rs
Square root
Produces the square root of a.
Accepts
a is a @rs, a single-precision float.
Produces
A @rs.
Source
++ sqt ~/ %sqt
|= [a=@rs] ^- @rs
~_ leaf+"rs-fail"
(sqt:ma a)
Examples
> (sqt:rs .2.5e2)
.1.5811388e1++lth:rs
Less than
Test whether a is less than b.
Accepts
a is a @rs, a single-precision float.
b is a @rs.
Produces
A @rs.
Source
++ lth ~/ %lth
|= [a=@rs b=@rs]
~_ leaf+"rs-fail"
(lth:ma a b)
Examples
> (lth:rs .9.9e1 .1.1e2)
%.y
> (lth:rs .9.9e1 .9.9e1)
%.n++lte:rs
Less than or equal
Test whether a is less than or equal to b.
Accepts
a is a @rs, a single-precision float.
b is a @rs.
Produces
A @rs.
Source
++ lte ~/ %lte
|= [a=@rs b=@rs]
~_ leaf+"rs-fail"
(lte:ma a b)
Examples
> (lte:rs .9.9e1 .1.1e2)
%.y
> (lte:rs .9.9e1 .9.9e1)
%.y++equ:rs
Equals
Test whether a is equal to b.
Accepts
a is a @rs, a single-precision float.
b is a @rs.
Produces
A @rs.
Source
++ equ ~/ %equ
|= [a=@rs b=@rs]
~_ leaf+"rs-fail"
(equ:ma a b)
Examples
> (equ:rs .9.9e1 .1.1e2)
%.n
> (equ:rs .9.9e1 .9.9e1)
%.y++gte:rs
Greater than or equal
Test whether a is greater than or equal to b.
Accepts
a is a @rs, a single-precision float.
b is a @rs.
Produces
A @rs.
Source
++ gte ~/ %gte
|= [a=@rs b=@rs]
~_ leaf+"rs-fail"
(gte:ma a b)
Examples
> (gte:rs .9.9e1 .9.9e1)
%.y
> (gte:rs .9.9e1 .9.2e2)
%.n++gth:rs
Greater than
Test whether a is greater than b.
Accepts
a is a @rs, a single-precision float.
b is a @rs.
Produces
A @rs.
Source
++ gth ~/ %gth
|= [a=@rs b=@rs]
~_ leaf+"rs-fail"
(gth:ma a b)
Examples
> (gth:rs .9.9e1 .9.2e2)
%.n
> (gth:rs .9.9e1 .9.9e1)
%.n
> (gth:rs .9.9e1 .1.9e1)
%.y++sun:rs
Unsigned integer to @rs
Converts a from an unsigned integer to @rs.
Accepts
a is an unsigned integer.
Produces
A @rs.
Source
++ sun |= [a=@u] ^- @rs (sun:ma a)
Examples
> (sun:rs 343)
.3.43e2++san:rs
Signed integer to @rs'
Converts a from an unsigned integer to @rs.
Accepts
a is a signed integer.
Produces
A @rs.
Source
++ san |= [a=@s] ^- @rs (san:ma a)
Examples
> (san:rs -343)
.-3.43e2'++sig:rs
Get sign
Produces the sign of a.
Accepts
a is a @rs.
Produces
A flag.
Source
++ sig |= [a=@rs] ^- ? (sig:ma a)
Examples
> (sig:rs .3.43e2)
%.y
> (sig:rs .-3.43e2)
%.n++exp:rs
Get exponent
Produces the exponent of a.
Accepts
a is a @rs.
Produces
A signed integer.
Source
++ exp |= [a=@rs] ^- @s (exp:ma a)
Examples
> (exp:rs .-3.43e2)
--8++toi:rs
Round to integer
Rounds a to the nearest integer.
Accepts
a is a @rs.
Produces
A unit of @s.
Source
++ toi |= [a=@rs] ^- (unit @s) (toi:ma a)
Examples
> (toi:rs .-3.43e2)
[~ u=-343]++drg:rs
@rs to decimal float
Produces the decimal form of a using the Dragon4 algorithm. Guarantees
accurate results for rounded floats.
Accepts
a is a @rs
Produces
A dn.
Source
++ drg |= [a=@rs] ^- dn (drg:ma a)
Examples
> (drg:rs .-3.43e2)
[%d s=%.n e=--0 a=343]++grd:rs
Decimal float to @rs
Converts a from dn to @rs.
Accepts
a is a dn.
Produces
A @rs.
Source
++ grd |= [a=dn] ^- @rs (grd:ma a)
--
Examples
> (grd:rs [%d s=%.n e=--0 a=343])
.-3.43e2++rq
Quadruple-precision fp
A container core for operations related to quadruple-precision binary floats.
++rq has four rounding modes: round to nearest ($n), round up ($u), round
down ($d), and round to zero ($z).
Source
++ rq
~% %rq +> ~
^?
|_ r=$?($n $u $d $z)
++ma:rq
Initialize ff
Instantiates the core ff, giving values to its samples based on the
configuration of the rq core.
Source
++ ma
%*(. ff w 15, p 112, b --16.383, r r)
++sea:rq
@rq to fn
Converts a from @rq to fn.
Accepts
a is a @rq, a quad-precision float.
Produces
An fn.
Source
++ sea
|= [a=@rq] (sea:ma a)
Examples
> (sea:rq .~~~1.05102e5)
[%f s=%.y e=-96 a=8.327.038.336.574.210.409.756.656.268.214.272]++bit:rq
fn to @rq
Converts a from fn to @rq.
Accepts
a is an fn.
Produces
A @rq, a quad-precision float.
Source
++ bit
|= [a=n] ^- @rq (bit:ma a)
Examples
> (bit:rq [%f s=%.y e=-96 a=8.327.038.336.574.210.409.756.656.268.214.272])
.~~~1.05102e5++add:rq
Add
Produces the sum of a plus b.
Accepts
a is a @rq, a quad-precision float.
b is a @rq.
Produces
A @rq.
Source
++ add ~/ %add
|= [a=@rq b=@rq] ^- @rq
~_ leaf+"rq-fail"
(add:ma a b)
Examples
> (add:rq .~~~-1.821e5 .~~~1.05102e5)
.~~~-7.6998e4++sub:rq
Subtract
Produces the difference of a minus b.
Accepts
a is a @rq, a quad-precision float.
b is a @rq.
Produces
A @rq.
Source
++ sub ~/ %sub
|= [a=@rq b=@rq] ^- @rq
~_ leaf+"rq-fail"
(sub:ma a b)
Examples
> (sub:rq .~~~1.821e5 .~~~1.05102e5)
.~~~7.6998e4
> (sub:rq .~~~1.821e5 .~~~-1.05102e5)
.~~~2.87202e5++mul:rq
Multiply
Produces the product of a times b.
Accepts
a is a @rq, a quad-precision float.
b is a @rq.
Produces
A @rq.
Source
++ mul ~/ %mul
|= [a=@rq b=@rq] ^- @rq
~_ leaf+"rq-fail"
(mul:ma a b)
Examples
> (mul:rq .~~~1.821e5 .~~~-1.05102e5)
.~~~-1.91390742e10++div:rq
Divide
Produces the product of a divided by b.
Accepts
a is a @rq, a quad-precision float.
b is a @rq.
Produces
A @rq.
Source
++ div ~/ %div
|= [a=@rq b=@rq] ^- @rq
~_ leaf+"rq-fail"
(div:ma a b)
Examples
> (div:rq .~~~1.821e5 .~~~1.05102e3)
.~~~1.732602614602957127361991208540275e2++fma:rq
Fused multiply-add
Produces the sum of c plus the product of a multiplied by b;
(a * b) + c.
Accepts
a is a @rq, a quad-precision float.
b is a @rq.
c is a @rq.
Produces
A @rq.
Source
++ fma ~/ %fma
|= [a=@rq b=@rq c=@rq] ^- @rq
~_ leaf+"rq-fail"
(fma:ma a b c)
Examples
> (fma:rq .~~~1.821e5 .~~~-1.05102e2 .~~~6.2044e7)
.~~~4.29049258e7++sqt:rq
Square root
Produces the square root of a.
Accepts
a is a @rq, a quad-precision float.
Produces
A @rq.
Source
++ sqt ~/ %sqt
|= [a=@rq] ^- @rq
~_ leaf+"rq-fail"
(sqt:ma a)
Examples
> (sqt:rq .~~~6.2044e7)
.~~~7.876801381271461258959876570289002e3++lth:rq
Less than
Tests whether a is less than b.
Accepts
a is a @rq, a quad-precision float.
b is a @rq.
Produces
A @rq.
Source
++ lth ~/ %lth
|= [a=@rq b=@rq]
~_ leaf+"rq-fail"
(lth:ma a b)
Examples
> (lth:rq .~~~1.2044e7 (mul:rq .~~~9.02e2 .~~~7.114e3))
%.n
> (lth:rq .~~~1.2044e7 (mul:rq .~~~9.02e3 .~~~7.114e3))
%.y++lte:rq
Less than or equal
Tests whether a is less than or equal to b.
Accepts
a is a @rq, a quad-precision float.
b is a @rq.
Produces
A @rq.
Source
++ lte ~/ %lte
|= [a=@rq b=@rq]
~_ leaf+"rq-fail"
(lte:ma a b)
Examples
> (lte:rq .~~~1.2044e7 (mul:rq .~~~9.02e2 .~~~7.114e3))
%.n
> (lte:rq .~~~1.2044e7 (mul:rq .~~~9.02e3 .~~~7.114e3))
%.y
> (lte:rq .~~~1.2044e7 .~~~1.2044e7)
%.y++equ:rq
Equals
Tests whether a is equal to b.
Accepts
a is a @rq, a quad-precision float.
b is a @rq.
Produces
A @rq.
Source
++ equ ~/ %equ
|= [a=@rq b=@rq]
~_ leaf+"rq-fail"
(equ:ma a b)
Examples
> (equ:rq .~~~1.2044e7 .~~~1.2044e7)
%.y
> (equ:rq .~~~2.2044e7 .~~~1.2044e7)
%.n++gte:rq
Greater than or equal
Tests whether a is greater than or equal to b.
Accepts
a is a @rq, a quad-precision float.
b is a @rq.
Produces
A @rq.
Source
++ gte ~/ %gte
|= [a=@rq b=@rq]
~_ leaf+"rq-fail"
(gte:ma a b)
Examples
> (gte:rq .~~~1.2044e7 .~~~1.2044e7)
%.y
> (gte:rq .~~~2.2044e7 .~~~1.2044e7)
%.y
> (gte:rq .~~~1.2044e7 .~~~2.2044e7)
%.n++gth:rq
Tests whether a is greater than b.
Accepts
a is a @rq, a quad-precision float.
b is a @rq.
Produces
A @rq.
Source
++ gth ~/ %gth
|= [a=@rq b=@rq]
~_ leaf+"rq-fail"
(gth:ma a b)
Examples
> (gth:rq .~~~1.2044e7 .~~~1.2044e7)
%.n
> (gth:rq .~~~2.2044e7 .~~~1.2044e7)
%.y
> (gth:rq .~~~1.2044e7 .~~~2.2044e7)
%.n++sun:rq
Unsigned integer to @rq
Converts @ from an unsigned integer to @rq.
Accepts
a is a @u, an unsigned integer.
Produces
A @rq, a quad-precision float.
Source
++ sun |= [a=@u] ^- @rq (sun:ma a)
Examples
> (sun:rq 205)
.~~~2.05e2++san:rq
Signed integer to rq
Converts @ from a signed integer to @rq.
Accepts
a is a @s, a signed integer.
Produces
A @rq, a quad-precision float.
Source
++ san |= [a=@s] ^- @rq (san:ma a)
Examples
> (san:rq -205)
.~~~-2.05e2++sig:rq
Get sign
Produces the sign of a.
Accepts
a is a @rq, a quad-precision float.
Produces
A flag.
Source
++ sig |= [a=@rq] ^- ? (sig:ma a)
Examples
> (sig:rq .~~~-2.05e2)
%.n++exp:rq
Get exponent
Gets the exponent of a.
Accepts
a is a @rq, a quad-precision float.
Produces
A @s, a signed integer.
Source
++ exp |= [a=@rq] ^- @s (exp:ma a)
Examples
> (exp:rq .~~~-2.05e2)
--7++toi:rq
Round to integer
Rounds a to the nearest integer.
Accepts
a is a @rq, a quad-precision float.
Produces
A unit of @s.
Source
++ toi |= [a=@rq] ^- (unit @s) (toi:ma a)
Examples
> (toi:rq .~~~-2.085e2)
[~ u=-208]
> (toi:rq .~~~-2.08e2)
[~ u=-208]++drg:rq
@rq to decimal float
Produces the decimal form of a using the Dragon4 algorithm. Guarantees
accurate results for rounded floats.
Accepts
a is a @rq, a quad-precision float.
Produces
A dn.
Source
++ drg |= [a=@rq] ^- dn (drg:ma a) :: @rq to decimal float
Examples
> (drg:rq .~~~-2.085e2)
[%d s=%.n e=-1 a=2.085]
> (drg:rq .~~~-2.08e2)
[%d s=%.n e=--0 a=208]++grd:rq
Decimal float to @rq
Converts a from dn to @rq.
Accepts
a is dn.
a is a @rq.
Produces
A @rq, a quad-precision float.
Source
++ grd |= [a=dn] ^- @rq (grd:ma a)
--
Examples
> (grd:rq [%d s=%.n e=--0 a=343])
.~~~-3.43e2++rh
Half-precision fp
A container core for operations related to half-precision binary floats.
++rh has four rounding modes: round to nearest ($n), round up ($u), round
down ($d), and round to zero ($z).
Source
++ rh
~% %rh +> ~
^?
|_ r=$?($n $u $d $z)
++ma:rh
Initialize ff
Instantiates the core ff, giving values to its samples based on the
configuration of the rh core.
Source
++ ma
%*(. ff w 5, p 10, b --15, r r)
++sea:rh
@rh to fn
Converts a from @rh to fn.
Accepts
a is a @rh, a half-precision float.
Produces
An fn.
Source
++ sea
|= [a=@rh] (sea:ma a)
Examples
> (sea:rh .~~1.22e-5)
[%f s=%.y e=-24 a=205]++bit:rh
fn to @rh
Converts a from fn to @rh.
Accepts
a is an fn.
Produces
A @rh, a half-precision float.
Source
++ bit
|= [a=fn] ^- @rh (bit:ma a)
Examples
> (bit:rh [%f s=%.y e=-24 a=205])
.~~1.22e-5++add:rh
Produces the sum of a plus b.
Accepts
a is a @rh, a half-precision float.
b is a @rh.
Produces
A @rh.
Source
++ add ~/ %add
|= [a=@rh b=@rh] ^- @rh
~_ leaf+"rh-fail"
(add:ma a b)
Examples
> (add:rh .~~1.82e2 .~~1.02e2)
.~~2.84e2++sub:rh
Subtract
Produces the difference of a minus b.
Accepts
a is a @rh, a half-precision float.
b is a @rh.
Produces
A @rh.
Source
++ sub ~/ %sub
|= [a=@rh b=@rh] ^- @rh
~_ leaf+"rh-fail"
(sub:ma a b)
Examples
> (sub:rh .~~1.821e2 .~~1.051e2)
.~~7.7e1
> (sub:rh .~~1.821e2 .~~6.051e2)
.~~-4.228e2++mul:rh
Multiply
Produces the product of a times b.
Accepts
a is a @rh, a quad-precision float.
b is a @rh.
Produces
A @rh.
Source
++ mul ~/ %mul
|= [a=@rh b=@rh] ^- @rh
~_ leaf+"rh-fail"
(mul:ma a b)
Examples
> (mul:rh .~~1.821e1 .~~-1.05102e2)
.~~-1.913e3++div:rh
Divide
Produces the product of a divided by b.
Accepts
a is a @rh, a half-precision float.
b is a @rh.
Produces
A @rh.
Source
++ div ~/ %div
|= [a=@rh b=@rh] ^- @rh
~_ leaf+"rh-fail"
(div:ma a b)
examples
> (div:rh .~~1.821e3 .~~1.05102e2)
.~~1.731e1++fma:rh
Fused multiply-add
Produces the sum of c plus the product of a multiplied by b;
(a * b) + c.
Accepts
a is a @rh, a half-precision float.
b is a @rh.
c is a @rh.
Produces
A @rh.
Source
++ fma ~/ %fma
|= [a=@rh b=@rh c=@rh] ^- @rh
~_ leaf+"rh-fail"
(fma:ma a b c)
Examples
> (fma:rh .~~1.821e4 .~~-1.05102e2 .~~6.2044e3)
.~~-6.55e4++sqt:rh
Square root
Produces the square root of a.
Accepts
a is a @rh, a half-precision float.
Produces
A @rh.
Source
++ sqt ~/ %sqt
|= [a=@rh] ^- @rh
~_ leaf+"rh-fail"
(sqt:ma a)
Source
> (sqt:rh .~~6.24e4)
.~~2.498e2
++lth:rh
Less than
Tests whether a is less than b.
Accepts
a is a @rh, a half-precision float.
b is a @rh.
Produces
A @rh.
Source
++ lth ~/ %lth
|= [a=@rh b=@rh]
~_ leaf+"rh-fail"
(lth:ma a b)
Examples
> (lth:rh .~~1.2e5 (mul:rh .~~9.02e2 .~~7.114e2))
%.n
> (lth:rh .~~1.2e3 (mul:rh .~~9.02e1 .~~7.114e2))
%.y++lte:rh
Less than or equal
Tests whether a is less than or equal to b.
Accepts
a is a @rh, a half-precision float.
b is a @rh.
Produces
A @rh.
Source
++ lte ~/ %lte
|= [a=@rh b=@rh]
~_ leaf+"rh-fail"
(lte:ma a b)
Examples
> (lte:rh .~~1.2e5 (mul:rh .~~9.02e2 .~~7.114e2))
%.n
> (lte:rh .~~1.2e3 (mul:rh .~~9.02e1 .~~7.114e2))
%.y
> (lte:rh .~~1.2e3 .~~1.2e3)
%.y++equ:rh
Equals
Tests whether a is equal to b.
Accepts
a is a @rh, a half-precision float.
b is a @rh.
Produces
A @rh.
Source
++ equ ~/ %equ
|= [a=@rh b=@rh]
~_ leaf+"rh-fail"
(equ:ma a b)
Examples
> (equ:rh .~~1.24e4 .~~1.24e4)
%.y
> (equ:rh .~~2.24e4 .~~1.24e4)
%.n++gte:rh
Greater than or equal
Tests whether a is greater than or equal to b.
Accepts
a is a @rh, a half-precision float.
b is a @rh.
Produces
A @rh.
Source
++ gte ~/ %gte
|= [a=@rh b=@rh]
~_ leaf+"rh-fail"
(gte:ma a b)
Examples
> (gte:rh .~~1.24e4 .~~1.24e4)
%.y
> (gte:rh .~~2.24e4 .~~1.24e4)
%.y
> (gte:rh .~~1.24e4 .~~2.24e4)
%.n++gth:rh
Tests whether a is greater than b.
Accepts
a is a @rh, a half-precision float.
b is a @rh.
Produces
A @rh.
Source
++ gth ~/ %gth
|= [a=@rh b=@rh]
~_ leaf+"rh-fail"
(gth:ma a b)
Examples
> (gth:rh .~~1.24e4 .~~1.244e4)
%.n
> (gth:rh .~~2.24e4 .~~1.24e4)
%.y
> (gth:rh .~~1.24e4 .~~2.24e4)
%.n++tos:rh
@rh to @rs
Converts @ from @rh to @rs.
Accepts
a is a @rh, a half-precision float.
Produces
A @rs, a single-precision float.
Source
++ tos |= {a/@rh} (bit:rs (sea a))
Examples
> (tos:rh .~~2.5e2)
.2.5e2++fos:rh
@rs to @rh
Converts @ from @rs to @rh.
Accepts
a is a @rs, a single-precision float.
Produces
A @rh, a half-precision float.
Source
++ fos |= {a/@rs} (bit (sea:rs a))
Examples
> (fos:rh .2.5e2)
.~~2.5e2++sun:rh
Unsigned integer to @rh
Converts @ from an unsigned integer to @rh.
Accepts
a is a @u, an unsigned integer.
Produces
A @rh, a half-precision float.
Source
++ sun |= [a=@u] ^- @rh (sun:ma a)
Examples
> (sun:rh 205)
.~~2.05e2++san:rh
Signed integer to @rh
Converts @ from a signed integer to @rh.
Accepts
a is a @s, a signed integer.
Produces
A @rh, a half-precision float.
Source
++ san |= [a=@s] ^- @rh (san:ma a)
Examples
> (san:rh -205)
.~~-2.05e2++sig:rh
Get sign
Produces the sign of a.
Accepts
a is a @rh, a half-precision float.
Produces
A flag.
Source
++ sig |= [a=@rh] ^- ? (sig:ma a)
Examples
> (sig:rh .~~-2.05e2)
%.n++exp:rh
Get exponent
Gets the exponent of a.
Accepts
a is a @rh, a half-precision float.
Produces
A @s, a signed integer.
Source
++ exp |= [a=@rh] ^- @s (exp:ma a)
Examples
> (exp:rh .~~-2.05e2)
--7++toi:rh
Round to integer
Rounds a to the nearest integer.
Accepts
a is a @rh, a half-precision float.
Produces
A unit of @s.
Source
++ toi |= [a=@rh] ^- (unit @s) (toi:ma a)
Examples
> (toi:rh .~~-2.085e2)
[~ u=-208]
> (toi:rh .~~-2.08e2)
[~ u=-208]++drg:rh
@rh to decimal float
Produces the decimal form of a using the Dragon4 algorithm. Guarantees
accurate results for rounded floats.
Accepts
a is a @rh, a half-precision float.
Produces
A dn.
Source
++ drg |= [a=@rh] ^- dn (drg:ma a)
Examples
> (drg:rh .~~-2.085e2)
[%d s=%.n e=-1 a=2.085]
> (drg:rh .~~-2.08e2)
[%d s=%.n e=--0 a=208]++grd:rh
Decimal float to @rh
Converts a from dn to @rh.
Accepts
a is dn.
a is a @rh.
Produces
A @rh, a a half-precision float.
Source
++ grd |= [a=dn] ^- @rh (grd:ma a)
--
Examples
> (grd:rh [%d s=%.n e=--0 a=343])
.~~-3.43e2