From 030bc84157963af4fc418690cd1c1235e7bd7ce2 Mon Sep 17 00:00:00 2001 From: Max G Date: Sun, 12 Jul 2015 20:26:23 +0300 Subject: [PATCH 01/20] new floating point --- arvo/hoon.hoon | 1611 ++++++++++++++++++++++++++++++++++++------------ 1 file changed, 1206 insertions(+), 405 deletions(-) diff --git a/arvo/hoon.hoon b/arvo/hoon.hoon index 1e3cba2c8e..37351de2be 100644 --- a/arvo/hoon.hoon +++ b/arvo/hoon.hoon @@ -1263,410 +1263,1182 @@ :::::::::::::::::::::::::::::::::::::::::::::::::::::::::: :: section 2cG, floating point :: :: -++ rlyd |= red=@rd ^- [s=? h=@ f=@ e=(unit tape) n=?] - ~& [%rlyd `@ux`red] - =+ s=(sea:rd red) - =+ negexp==(1 (mod e.s 2)) - [s=(sig:rd red) h=(hol:rd red) f=(fac:rd red) e=(err:rd red) n=negexp] -++ rlyh |=(reh=@rh ~|(%realh-nyet ^-([s=? h=@ f=@ e=(unit tape) n=?] !!))) -++ rlyq |=(req=@rq ~|(%realq-nyet ^-([s=? h=@ f=@ e=(unit tape) n=?] !!))) -++ rlys |=(res=@rs ~|(%reals-nyet ^-([s=? h=@ f=@ e=(unit tape) n=?] !!))) -++ ryld |= v=[syn=? hol=@ zer=@ fac=@ exp=(unit ,@)] ^- @rd - ?: &(=(hol.v 0) =(zer.v 0) =(fac.v 0)) - (bit:rd (szer:vl:fl 1.023 52 syn.v)) - ?~ exp.v - (bit:rd (cof:fl 52 1.023 v)) - (ipow:rd u.exp.v (bit:rd (cof:fl 52 1.023 v))) -++ rylh |=([syn=? hol=@ zer=@ fac=@ exp=(unit ,@)] ~|(%realh-nyet ^-(@rh !!))) -++ rylq |=([syn=? hol=@ zer=@ fac=@ exp=(unit ,@)] ~|(%realq-nyet ^-(@rq !!))) -++ ryls |=([syn=? hol=@ zer=@ fac=@ exp=(unit ,@)] ~|(%reals-nyet ^-(@rs !!))) - -:: Floating point operations for general floating points. -:: [s=sign, e=unbiased exponent, f=fraction a=ari] -:: Value of floating point = (-1)^s * 2^h * (1.f) = (-1)^s * 2^h * a +++ fn :: float, infinity, or NaN + :: s=sign, e=exponent, a=arithmetic form + :: (-1)^s * a * 2^e + $% [%f s=? e=@s a=@u] + [%i s=?] + [%n ~] + == +:: +++ dn :: decimal float, infinity, or NaN + :: (-1)^s * a * 10^e + $% [%d s=? e=@s a=@u] + [%i s=?] + [%n ~] + == +:: ++ fl + =+ ^- [[p=@u v=@s w=@u] r=?(%n %u %d %z %a) d=?(%d %f %i)] + [[113 -16.494 32.765] %n %d] |% - :: ari, or arithmetic form = 1 + mantissa - :: passing around this is convenient because it preserves - :: the number of zeros + :: p=precision: number of bits in arithmetic form; must be at least 2 + :: v=min exponent: minimum value of e + :: w=width: max - min value of e, 0 is fixed point + :: r=rounding mode: nearest (ties to even), up, down, to zero, away from zero + :: d=behavior: return denormals, flush denormals to zero, + :: infinite exponent range + ++ rou + |= [a=fn] ^- fn + ?. ?=([%f *] a) a + ?~ a.a [%f s.a zer:m] + ?: s.a (rou:m +>.a) + =.(r swr:m (fli (rou:m +>.a))) :: - :: more sophisticated people call this the significand, but that starts - :: with s, and sign already starts with s, so the variables wouldn't be - :: named very nicely + ++ fli + |= [a=fn] ^- fn + ?-(-.a %f a(s !s.a), %i a(s !s.a), %n a) :: - :: Law: =((met 0 (ari p m)) +(p)) - ++ ari |= [p=@u m=@u] ^- @ - :: (lia p (mix (lsh 0 (met 0 m) 1) m)) - (mix (lsh 0 p 1) m) + ++ abs + |= [a=fn] ^- fn + ?: ?=([%f *] a) [%f & e.a a.a] + ?: ?=([%i *] a) [%i &] [%n ~] :: - :: bex base a to power p (call w/ b=0 c=1). very naive (need to replace) - :: or jet - ++ bey |= [a=@u p=@u b=@u c=@u] ^- @u - ?: =(b p) - c - $(c (^mul c a), b (^add b 1)) + ++ 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:m] + ?: =(s.a s.b) + ?: s.a (add:m +>.a +>.b |) + =.(r swr:m (fli (add:m +>.a +>.b |))) + ?: s.a (sub:m +>.a +>.b |) + (sub:m +>.b +>.a |) :: - :: convert from sign/whole/frac -> sign/exp/ari w/ precision p, bias b - :: g is garbage - ++ cof |= [p=@u b=@u s=? h=@u z=@ f=@u g=(unit ,@)] ^- [s=? e=@s a=@u] - ?: &(=(0 h) =(0 f)) - [s=s e=`@s`(dec (^mul 2 b)) a=(ari p 0)] - ?: &(=(0 h)) - =+ a=(fra (^add p b) z f) ::p+b bits - =+ e=(dif:si (sun:si (met 0 a)) (sun:si +((^add p b)))) - [s=s e=e a=(lia p a)] - =+ c=(fra p z f) :: p-bits - =+ a=(mix c (lsh 0 p h)) - =+ e=(dif:si (sun:si (met 0 a)) (sun:si +(p))) - [s=s e=e a=(lia p a)] + ++ ead :: exact 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)) ?~(a.a b a) + [%f ?:(=(r %d) &(s.a s.b) |(s.a s.b)) zer:m] + ?: =(s.a s.b) + ?: s.a (add:m +>.a +>.b &) + (fli (add:m +>.a +>.b &)) + ?: s.a (sub:m +>.a +>.b &) + (sub:m +>.b +>.a &) :: - :: convert from sign/exp/ari -> sign/whole/frac w/ precision q - ++ cog |= [q=@u s=? e=@s a=@u] ^- [s=? h=@u f=@u] - ::?: =(e -0) - :: [s=s h=1 f=(fre q a) - ::?: =((mod `@u`s 2) 0) :: pos - :: (coh q s e a) - ::?: =((mod `@u`s 2) - ::=+ (^mul ari (bex e)) - !! + ++ sub + |= [a=fn b=fn] ^- fn (add a (fli b)) :: - :: Decimal length of number, for use in ++den - ++ dcl |= [f=@u] ^- @u - ?: =(f 0) - 0 - (^add 1 $(f (^div f 10))) + ++ 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:m] + ?: =(s.a s.b) (mul:m +>.a +>.b) + =.(r swr:m (fli (mul:m +>.a +>.b))) :: - :: Denominator of fraction, f is base 10 - ++ den |= [f=@u z=@u] ^- @u - (bey 10 (^add z (dcl f)) 0 1) - - :: Binary fraction of precision p (ex, for doubles, p=52) - ++ fra |= [p=@u z=@u f=@u] ^- @u - (^div (lsh 0 p f) (den f z)) + ++ emu :: exact multiply + |= [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:m] + [%f =(s.a s.b) (sum:si e.a e.b) (^mul a.a a.b)] :: - - :: utility for ++fre - ++ rep |= [a=@ f=$+(@ @) c=@u] - ^- @ - ?: =(c 0) - a - $(a (f a), c (dec c)) - :: Decimal fraction of precision q [for printing only] mas peg - ++ fre |= [q=@u n=[s=? e=@s a=@u]] ^- @u - =+ ^= b - ?: =(0 (mod e.n 2)) - ?: (^gte (abs:si e.n) (met 0 a.n)) - 1 - ::=+ k=(lsh 0 (^sub (dec (met 0 a.n)) (abs:si e.n)) 1) - ::=+ r=(end 0 (^sub (dec (met 0 a.n)) (abs:si e.n)) a.n) - ::(mix k r) - (rep a.n mas (abs:si e.n)) - ::=+ k=(lsh 0 (^add (dec (met 0 a.n)) (abs:si e.n)) 1) - ::=+ g=(lsh 0 (dec (met 0 a.n)) 1) - :::(mix k g a.n) - ::(rep a.n |=(a=@ (^mul 2 (peg a 0b10))) (abs:si e.n)) :: kill & move - a.n - ~& `@ub`b - ?: =(0 (mod e.n 2)) - =+ d=(bex (^sub (met 0 b) 1)) - (^div (^mul b (bey 10 q 0 1)) d) - =+ d=(bex (^add (abs:si e.n) (dec (met 0 b)))) - (^div (^mul b (bey 10 q 0 1)) d) + ++ 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:m] + ?: =(a.a 0) ?: =(a.b 0) [%n ~] [%f =(s.a s.b) zer:m] + ?: =(a.b 0) [%i =(s.a s.b)] + ?: =(s.a s.b) (div:m +>.a +>.b) + =.(r swr:m (fli (div:m +>.a +>.b))) :: - ++ hol |= [p=@u n=[s=? e=@s a=@u]] ^- @u - ?: =((mod `@`e.n 2) 0) - ?: (^gte (abs:si e.n) p) - (lsh 0 (^sub (abs:si e.n) p) a.n) - (rsh 0 (^sub p (abs:si e.n)) a.n) - 0 + ++ fma :: a * b + c + |= [a=fn b=fn c=fn] ^- fn + (add (emu a b) c) :: - :: reverse ari, ari -> mantissa - ++ ira |= a=@u ^- @u - (mix (lsh 0 (dec (met 0 a)) 1) a) + ++ sqt :: square root + |= [a=fn] ^- fn + ?: ?=([%n *] a) [%n ~] + ?: ?=([%i *] a) ?:(s.a a [%n ~]) + ?~ a.a [%f s.a zer:m] + ?: s.a (sqt:m +>.a) [%n ~] :: - :: limit ari to precision p. Rounds if over, lsh if under. - ++ lia |= [p=@u a=@u] ^- @u - ?: (^lte (met 0 a) (^add p 1)) - (lsh 0 (^sub (^add p 1) (met 0 a)) a) - (rnd p a) + ++ isr :: inverse square root + |= [a=fn] ^- fn + ?: ?=([%n *] a) [%n ~] + ?: ?=([%i *] a) [%n ~] + ?~ a.a [%n ~] + ?: s.a (isr:m +>.a) [%n ~] :: - :: round to nearest or even based on r (which has length n) - :: n should be the actual length of r, as it exists within a - :: The result is either (rhs 0 n a) or +(rsh 0 n a) - ++ rnd |= [p=@u a=@u] ^- @u - ?: (^lte (met 0 a) (^add p 1)) - a :: avoid overflow - =+ n=(^sub (met 0 a) (^add p 1)) - =+ r=(end 0 n a) - (rne p a r n) + ++ inv + |= [a=fn] ^- fn + (div [%f & --0 1] a) :: - :: the real rnd - ++ rne |= [p=@u a=@u r=@u n=@u] ^- @u - =+ b=(rsh 0 n a) - ?: =(n 0) - a - ?: !=((met 0 r) n) :: starts with 0 => not same distance - b - ?: =((mod r 2) 0) - $(a (rsh 0 1 a), r (rsh 0 1 r), n (dec n)) :: ending 0s have no effect - ?: =(r 1) :: equal distance, round to even - ?: =((mod b 2) 0) - b - +(b) - +(b) :: starts with 1, not even distance - :::::::::::: - :: black magic values - ++ vl + ++ sun + |= [a=@u] ^- fn + (rou [%f & --0 a]) + :: + ++ san + |= [a=@s] ^- fn + =+ b=(old:si a) + (rou [%f -.b --0 +.b]) + :: + ++ 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:m +>.a +>.b) (lth:m +>.b +>.a) + :: + ++ lte + |= [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 (lte:m +>.a +>.b) (lte:m +>.b +>.a) + :: + ++ 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:m +>.a +>.b) + :: + ++ gte + |= [a=fn b=fn] ^- (unit ,?) (lte b a) + :: + ++ gth + |= [a=fn b=fn] ^- (unit ,?) (lth b a) + :: + ++ drg :: float to decimal + |= [a=fn] ^- dn + ?: ?=([%n *] a) [%n ~] + ?: ?=([%i *] a) [%i s.a] + ?~ a.a [%d s.a --0 0] + [%d s.a (drg:m +>.a)] + :: + ++ grd :: decimal to float + |= [a=dn] ^- fn + ?: ?=([%n *] a) [%n ~] + ?: ?=([%i *] a) [%i s.a] + =+ q=(abs:si e.a) + ?: (syn:si e.a) + (mul [%f s.a --0 a.a] [%f & e.a (pow:m 5 q)]) + (div [%f s.a --0 a.a] [%f & (sun:si q) (pow:m 5 q)]) + :: + ++ c :: mathematical constants |% - ++ szer |= [b=@u p=@u s=?] - [s=s e=`@s`(dec (^mul b 2)) a=(lia p 0b1)] - - ++ qnan |= [b=@u p=@u s=?] - [s=s e=`@s`(^mul 2 +(b)) a=(lia p `@`0b11)] - - ++ snan |= [b=@u p=@u s=?] - [s=s e=`@s`(^mul 2 +(b)) a=(lia p `@`0b101)] - - ++ inft |= [b=@u p=@u s=?] - [s=s e=`@s`(^mul 2 +(b)) a=(lia p `@`0b1)] + ++ pi + ~+ |- ^- fn + ?: (^lth prc:m 1.200) + =+ ^= ap 0wOg~qE.y5EMz.j4NCa.bwdMs.QiA2j.wyapY.NQ0wK.-FzIj. + CO9hi.wxVzz.g4Tu-.l6rfd.eAcrc.2Iarv.9v53t.fUjlJ. + rl72h.ui5Jn.pynDX.6Z4N2.WqoTX.mIb~R.OSZ0q.TXuUU. + q~Jqy.p-BHF.YA4nN.b7-p9.a6phX.ehrfs.80vby.xoXY5. + CdF8d.xNlQV.FF5z-.E~ijf.nUdBn.ifsEW.Sm76b.Ply25 + (rau:m [-1.198 ap] |) + =- + =+ wp=(^add prc:m 16) + =+ nc=16 + |- + ?: (^gth wp mxp:m) + ~| %very-large-precision !! + =+ [x=(bnd:m (ka wp))] + ?~ x $(wp (^add wp nc), nc (^mul nc 2)) + +.x + :: + ^= ka |= [p=@] ^- [fn fn] + => .(r %n, ^p p, d %i) + =+ [a=`fn`[%f & --0 1] b=`fn`[%f & -1 1]] + =+ [d=`fn`[%f & -2 1] la=a k=0] + |- + =+ s=(shf:m (add a b) -2) + =+ lb=(sqt b) + =. la (shf:m (add la lb) -1) + =. a (mul la la) + =. b (shf:m (sub a s) --1) + =+ e=(ned:m (ead a (fli b))) + =. d (sub d e(e (sum:si e.e (sun:si k)))) + =+ f=(dif:si (sun:si k) (sun:si p)) + ?: (need (gth (abs e) [%f & f 1])) + $(k +(k)) + =+ ^= g + (dif:si (sun:si (^add (^mul k 2) 8)) (sun:si p)) + [(div b d) [%f & g 1]] + :: + ++ log2 :: natural logarithm of 2 + ~+ |- ^- fn + ?: (^lth prc:m 1.200) + =+ ^= ap 0wIn8nZ.Z7fuq.L9UXe.o0~bS.HQ3Pg.OpOCb.oJywQ.nmUKG. + -yLDK.7owru.KIC5m.lkLJa.-xIgX.iWKds.4U8kg.DlPIF. + 4mCU9.jWmOx.oyiKz.56ILq.4j5Ye.7WVWF.L3Ijp.weOlL. + EeNSl.~tbsI.W7IpR.BicHR.TWqZe.30Oi6.lvEos.L8eey. + SySnN.gY~Rs.o7ZcE.h-RLX.A64dc.fyfVl.6yXBq.trvMu + (rau:m [-1.200 ap] |) + =- + =+ wp=(^add prc:m 16) + =+ nc=16 + |- + ?: (^gth wp mxp:m) + ~| %very-large-precision !! + =+ [x=(bnd:m (ka wp))] + ?~ x $(wp (^add wp nc), nc (^mul nc 2)) + +.x + :: + ^= ka |= [p=@] ^- [fn fn] + => .(r %n, ^p p, d %i) + =+ n=+((^div p 3)) + =+ o=(dec (^mul n 2)) + =+ ^= q %- sun + %+ ^mul 4 + %+ ^mul (bex (dec n)) + %- fac:m [0 o] + =+ ^= t %- sun + %+ ^mul 3 + =+ [c=0 d=0] + |- ?: =(c n) d + =+ ^= e + =+ f=(fac:m 0 c) + %+ ^mul (^mul f f) + %+ ^mul (bex (^sub (dec n) c)) + %+ fac:m +((^mul c 2)) o + $(c +(c), d ?~((end 0 1 c) (^add d e) (^sub d e))) + [(div t q) [%f & (dif:si --2 (sun:si p)) 1]] -- - :: black magic value tests - ++ te + :: + ++ e :: elementary functions |% - ++ zer |= [b=@u p=@u n=[s=? e=@s a=@u]] - =(e.n (dec (^mul b 2))) - - ++ nan |= [b=@u n=[s=? e=@s a=@u]] - &(=(e.n (^mul 2 +(b))) !=(0 (ira a.n))) - - ++ snan |= [b=@u n=[s=? e=@s a=@u]] - &(=(e.n (^mul 2 +(b))) !=((dec (met 0 a.n)) (met 0 (ira a.n)))) - - ++ inf |= [b=@u n=[s=? e=@s a=@u]] - &(=(e.n (^mul 2 +(b))) =(0 (ira a.n))) - - ++ gar |= [b=@u n=[s=? e=@s a=@u] m=[s=? e=@s a=@u]] - ^- (unit ,[s=? e=@s a=@u]) - ?: (snan b n) ~|(%floating-nan !!) - ?: (snan b n) ~|(%floating-nan !!) - ?: (nan b n) [~ n] - ?: (nan b m) [~ m] - ~ - ++ pro |= [b=@u p=@u n=[s=? e=@s a=@u]] - ^- [s=? e=@s a=@u] - =+ maxexp=`@s`(^mul 2 +(b)) - =+ minexp=`@s`(dec (^mul 2 b)) - ?: &(=(0 (mod e.n 2)) (^gte e.n maxexp)) - (inft:vl:fl b p s.n) - ?: &(=(1 (mod e.n 2)) (^gte e.n minexp)) - (szer:vl:fl b p s.n) :: flush denorms - n - ++ err |= [b=@u p=@u n=[s=? e=@s a=@u]] - ^- (unit tape) - ?: (snan b n) [~ "snan"] - ?: (nan b n) [~ "nan"] - ?: (inf b n) [~ "inf"] - ?: (zer b p n) [~ "0"] - ~ + ++ cos + |= [a=fn] ^- fn + ?. ?=([%f *] a) [%n ~] + ?: =(a.a 0) (rou [%f & --0 1]) + =- + =+ wp=(^add prc:m 16) + =+ nc=16 + |- + ?: (^gth wp mxp:m) + ~| %very-large-precision !! + =+ [x=(bnd:m (ka wp))] + ?~ x $(wp (^add wp nc), nc (^mul nc 2)) + +.x + :: + ^= ka |= [p=@] ^- [fn fn] + =+ n=prc:m + => .(r %n, ^p p, d %i) + =. a + =+ q=(ibl:m +>.a) + ?: =((cmp:si q --1) -1) a + =+ ^= pi + => .(^p (^add ^p (abs:si q))) + (shf:m pi:c --1) + (ned:m (rem:m a pi)) + =+ k=-:(itr:m (^div n 2)) + =+ ^= i %+ shf:m =>(.(r %u) (mul a a)) + (new:si | (^mul k 2)) + =+ [s=`fn`[%f & --0 1] t=`fn`[%f & --0 1] l=1] + |- + ?> ?=([%f *] t) + ?. ?| + =(a.t 0) + =+ q=(dif:si (ibl:m +>.t) --1) + =((cmp:si q (new:si | p)) -1) + == + =. t (ned:m =>(.(r %u) (mul t i))) + =+ ^= q + =+ j=(^mul l 2) + (^mul j (dec j)) + =. t (ned:m =>(.(r %u) (div t [%f & --0 q]))) + =+ u=?~((dis 1 l) t (fli t)) + =. s (ned:m =>(.(r %d) (add s u))) + $(l +(l)) + =+ w=k + |- ?~ k :- s + =+ q=(dif:si (sun:si (^mul w 2)) (sun:si p)) + [%f & q +((^mul l 2))] + =. s + =+ q=(ned:m =>(.(r %u) (mul s s))) + (sub q(e (sum:si e.q --1)) [%f & --0 1]) + $(k (dec k)) + :: + ++ sin + |= [a=fn] ^- fn + ?. ?=([%f *] a) [%n ~] + ?: =(a.a 0) [%f & zer:m] + =- + =+ wp=(^add prc:m 16) + =+ nc=16 + |- + ?: (^gth wp mxp:m) + ~| %very-large-precision !! + =+ [x=(bnd:m (ka wp))] + ?~ x $(wp (^add wp nc), nc (^mul nc 2)) + +.x + :: + ^= ka |= [p=@] ^- [fn fn] + => .(r %n, ^p p, d %i) + =. a + =+ q=(ibl:m +>.a) + ?: =((cmp:si q --1) -1) a + =+ ^= pi + => .(^p (^add ^p (abs:si q))) + (shf:m pi:c --1) + (ned:m (rem:m a pi)) + =+ c==>(.(r %a) (cos a)) + =+ t==>(.(r %a) (mul c c)) + =+ u==>(.(r %z) (sub [%f & --0 1] t)) + =+ s=(ned:m =>(.(r %z) (sqt u))) + :- s(s +<.a) + =+ e=(sum:si (sun:si (^mul p 2)) e.s) + [%f & (dif:si --3 e) 1] + :: + ++ tan + |= [a=fn] ^- fn + ?. ?=([%f *] a) [%n ~] + =- + =+ wp=(^add prc:m 8) + =+ nc=8 + |- + ?: (^gth wp mxp:m) + ~| %very-large-precision !! + =+ [x=(bnd:m (ka wp))] + ?~ x $(wp (^add wp nc), nc (^mul nc 2)) + +.x + :: + ^= ka |= [p=@] ^- [fn fn] + => .(r %n, ^p p, d %i) + =+ [s=(sin a) c=(cos a)] + =+ t=(div s c) + ?. ?=([%f *] t) [t [%f & zer:m]] + [t [%f & e.t 4]] + :: + ++ acos + |= [a=fn] ^- fn + !! + :: + ++ asin + |= [a=fn] ^- fn + !! + :: + ++ atan + |= [a=fn] ^- fn + !! + :: + ++ cosh + |= [a=fn] ^- fn + !! + :: + ++ sinh + |= [a=fn] ^- fn + !! + :: + ++ tanh + |= [a=fn] ^- fn + !! + :: + ++ acosh + |= [a=fn] ^- fn + !! + :: + ++ asinh + |= [a=fn] ^- fn + !! + :: + ++ atanh + |= [a=fn] ^- fn + !! + :: + ++ exp + |= [a=fn] ^- fn + ?: ?=([%n *] a) [%n ~] + ?: ?=([%i *] a) ?:(s.a [%i &] [%f & zer:m]) + ?~ a.a (rou [%f & --0 1]) + =- + =+ wp=(^add prc:m 16) + =+ nc=16 + |- + ?: (^gth wp mxp:m) + ~| %very-large-precision !! + =+ [x=(bnd:m (ka wp))] + ?~ x $(wp (^add wp nc), nc (^mul nc 2)) + +.x + :: + ^= ka |= [p=@] ^- [fn fn] + => .(r %n, ^p p, d %i) + !! + :: + ++ log + |= [a=fn] ^- fn + ?: ?=([%n *] a) [%n ~] + ?: ?=([%i *] a) ?:(s.a [%i &] [%n ~]) + ?~ a.a [%i |] ?. s.a [%n ~] + ?: (need (equ a [%f & --0 1])) [%f & zer:m] + =- + =+ wp=(^add prc:m 16) + =+ nc=16 + |- + ?: (^gth wp mxp:m) + ~| %very-large-precision !! + =+ [x=(bnd:m (ka wp))] + ?~ x $(wp (^add wp nc), nc (^mul nc 2)) + +.x + :: + ^= ka |= [p=@] ^- [fn fn] + => .(r %n, ^p p, d %i) + =+ ^= n + =+ q=(sun:si (^div +(^p) 2)) + (sum:si (dif:si q (ibl:m +>.a)) --2) + =. a (ned:m (shf:m a n)) + =. a (ned:m (agm [%f & --0 1] (div [%f & --0 4] a))) + =. a (ned:m (shf:m a --1)) + =. a (ned:m (div pi:c a)) + =+ j=(old:si n) + =+ q=(mul [%f -.j --0 +.j] log2:c) + =+ b=(ned:m (sub a q)) + =+ e=(dif:si (ibl:m +>.a) (ibl:m +>.b)) + :- b [%f & (sum:si e.b e) 11] + :: + ++ log2 + |= [a=fn] ^- fn + ?: ?=([%n *] a) [%n ~] + ?: ?=([%i *] a) ?:(s.a [%i &] [%n ~]) + ?~ a.a [%i |] ?. s.a [%n ~] + =+ q=(ibl:m +>.a) + ?: (need (equ a [%f & q 1])) + (rou [%f (syn:si q) --0 (abs:si q)]) + =- + =+ wp=(^add prc:m 8) + =+ nc=8 + |- + ?: (^gth wp mxp:m) + ~| %very-large-precision !! + =+ [x=(bnd:m (ka wp))] + ?~ x $(wp (^add wp nc), nc (^mul nc 2)) + +.x + :: + ^= ka |= [p=@] ^- [fn fn] + => .(r %n, ^p p, d %i) + =+ q==>(.(r %d) log2:c) + =+ z=(ned:m (div (log a) q)) + :- z [%f & e.z 5] + :: + ++ log10 + |= [a=fn] ^- fn + !! + :: + ++ pow + |= [a=fn b=fn] ^- fn + !! + :: + ++ agm :: arithmetic-geometric mean + |= [a=fn b=fn] ^- fn + ?: |(?=([%n *] a) ?=([%n *] b)) [%n ~] + ?: &(?=([%i *] a) ?=([%i *] b)) + ?: &(=(s.a s.b) s.a) a [%n ~] + ?: ?=([%i *] a) ?> ?=([%f *] b) + ?: |(=(a.b 0) !s.a) [%n ~] [%i &] + ?: ?=([%i *] b) ?> ?=([%f *] a) + ?: |(=(a.a 0) !s.b) [%n ~] [%i &] + ?: |(=(a.a 0) =(a.b 0)) [%f & zer:m] + ?. &(s.a s.b) [%n ~] + =- + =+ wp=(^add prc:m 16) + =+ nc=16 + |- + ?: (^gth wp mxp:m) + ~| %very-large-precision !! + =+ [x=(bnd:m (ka wp))] + ?~ x $(wp (^add wp nc), nc (^mul nc 2)) + +.x + :: + ^= ka |= [p=@] ^- [fn fn] + => .(r %n, ^p p, d %i) + =+ s=(ned:m (mul a b)) + =+ u=(ned:m (sqt s)) + =+ ^= v + =+ q=(ned:m (add a b)) + q(e (dif:si e.q --1)) + =+ n=1 |- + =+ j=(ned:m (ead v (fli u))) + =+ ^= y |. %+ cmp:si %- need (cmp2:m v j) + (sun:si (^sub p 2)) + ?: |(=(a.j 0) =((y) --1)) + [v [%f & e.v (^add (^mul n 18) 51)]] :: XX error bounds correct? + =+ ^= nv + =+ q=(ned:m (add u v)) + q(e (dif:si e.q --1)) + $(v nv, u (ned:m (sqt (mul u v))), n +(n)) + -- + :: + ++ m :: internal functions, constants + |% :: don't put 0s into [@s @u] args + ++ rou + |= [a=[e=@s a=@u]] ^- fn (rau a &) + :: + ++ 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) + == + :: + ++ 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 exponent + ?: 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 exponent of a + ?: (^gth prc ma) (^^sub prc ma) 0 + =+ ^= x %+ sum:si e.b (sun:si mb) :: highest exponent that b reaches + ?: =((cmp:si w x) --1) :: don't actually need to add + ?- r + %z (lag %fl a) %d (lag %fl a) + %a (lag %lg a) %u (lag %lg a) + %n (lag %na a) + == + (rou [e.b (^^add (lsh 0 (abs:si q) a.a) a.b)]) + :: + ++ 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 (lag %sm a) %d (lag %sm a) + %a (lag %ce a) %u (lag %ce a) + %n (lag %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]) + :: + ++ mul + |= [a=[e=@s a=@u] b=[e=@s a=@u]] ^- fn + (rou (sum:si e.a e.b) (^^mul a.a a.b)) + :: + ++ 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=(^^div a.a a.b)] + ?+ r (rou [j q]) + %u ?~ (mod a.a a.b) (lag %ce [j q]) (lag %lg [j q]) + %a ?~ (mod a.a a.b) (lag %ce [j q]) (lag %lg [j q]) + %n ?~ (mod a.a a.b) (lag %ne [j q]) (lag %na [j q]) + == + :: + ++ fma + |= [a=[e=@s a=@u] b=[e=@s a=@u] c=[e=@s a=@u]] ^- fn + (add [(sum:si e.a e.b) (^^mul a.a a.b)] c |) + :: + ++ fms + |= [a=[e=@s a=@u] b=[e=@s a=@u] c=[e=@s a=@u] d=?] ^- fn + ?: d (sub [(sum:si e.a e.b) (^^mul a.a a.b)] c |) + (sub c [(sum:si e.a e.b) (^^mul a.a a.b)] |) + :: + :: integer square root w/sticky bit + ++ itr + |= [a=@] ^- [@ ?] + =+ [q=(^^div (dec (xeb a)) 2) r=0] + =+ ^= c + |- =+ s=(^^add r (bex q)) + =+ (^^mul s s) + ?: =(q 0) + ?: (^^lte - a) [s -] [r (^^mul r r)] + ?: (^^lte - a) $(r s, q (dec q)) $(q (dec q)) + [-.c =(+.c a)] + :: + :: integer inverse square root w/shift amount & sticky bit + ++ iir + |= [a=@] ^- [@ @ ?] + =+ [sa=(dec (xeb a))] + =+ [q=(^^div (xeb a) 2) z=(bex (^^mul sa 2)) r=0] + =+ ^= c + |- =+ s=(^^add r (bex q)) + =+ (^^mul a (^^mul s s)) + ?: =(q 0) + ?: (^^lte - z) [s -] [r (^^mul a (^^mul r r))] + ?: (^^lte - z) $(r s, q (dec q)) $(q (dec q)) + [-.c sa =(+.c z)] + :: + ++ frd :: a/2, rounds to -inf + |= [a=@s] + =+ b=(old:si a) + ?: |(-.b =((end 0 1 +.b) 0)) + (new:si -.b (rsh 0 1 +.b)) + (new:si -.b +((rsh 0 1 +.b))) + :: + ++ 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) :: enforce even exponent + a(e (dif:si e.a (sun:si -)), a (lsh 0 - a.a)) + =+ [y=(itr a.a) z=(frd e.a)] + (rau [z -.y] +.y) + :: + ++ isr + |= [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=(iir a.a) z=(frd e.a)] + =+ q=(new:si !(syn:si z) (abs:si z)) + (rau [(dif:si q (sun:si +<.y)) -.y] +>.y) + :: + ++ 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) + :: + ++ lte + |= [a=[e=@s a=@u] b=[e=@s a=@u]] ^- ? + ?: =(e.a e.b) (^^lte a.a a.b) + =+ c=(cmp:si (ibl a) (ibl b)) + ?: =(c -1) & ?: =(c --1) | + ?: =((cmp:si e.a e.b) -1) + (^^lte a.a (lsh 0 (abs:si (dif:si e.a e.b)) a.b)) + (^^lte (lsh 0 (abs:si (dif:si e.a e.b)) a.a) a.b) + :: + ++ 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) + :: + :: integer binary logarithm: 2^ibl(a) <= |a| < 2^(ibl(a)+1) + ++ ibl + |= [a=[e=@s a=@u]] ^- @s + (sum:si (sun:si (dec (met 0 a.a))) e.a) + :: + ++ uni + |= [a=[e=@s a=@u]] + ?< =(a.a 0) + |- ?: =((end 0 1 a.a) 1) a + $(a.a (rsh 0 1 a.a), e.a (sum:si e.a --1)) + :: + ++ unj :: used internally by rounding + |= [a=[e=@s a=@u]] + =+ ma=(met 0 a.a) + ?: =(ma +(prc)) + a(a (rsh 0 1 a.a), e (sum:si e.a --1)) + ?> ?| + =(ma prc) + &(!=(den %i) =(e.a emn) (^^lth ma prc)) + == + a + :: + :: assumes that (met 0 a.a) <= prc!! + ++ xpd + |= [a=[e=@s a=@u]] + =+ ?: =(den %i) (^^sub prc (met 0 a.a)) + =+ ^= q + =+ w=(dif:si e.a emn) + ?: (syn:si w) (abs:si w) 0 + (min q (^^sub prc (met 0 a.a))) + a(e (dif:si e.a (sun:si -)), a (lsh 0 - a.a)) + :: + :: required precision if sticky bit + ++ rpr + |= [a=@s] + ?: |(=(den %i) =((cmp:si emn a) -1)) +(prc) + =+ b=(abs:si (dif:si emn a)) + ?: (^^lte b prc) (^^add (^^sub prc b) 2) 1 + :: + :: in order: floor, ceiling, nearest (even, away from 0, toward 0), larger, smaller + ++ lag + |= [t=?(%fl %ce %ne %na %nt %lg %sm) a=[e=@s a=@u]] ^- fn + (lug t a &) + :: + :: t=sticky bit + ++ lug + |= [t=?(%fl %ce %ne %na %nt %lg %sm) a=[e=@s a=@u] s=?] ^- fn + :: + =- :: if !den, flush denormals to zero + ?. =(den %f) - + ?. ?=([%f *] -) - + ?: =((met 0 ->+>) prc) - [%f & zer] + :: + =+ m=(met 0 a.a) + ?> |(s (^gte m (rpr e.a))) :: sticky bit requires precision + =+ ^= q + =+ ^= f :: reduce precision + ?: (^gth m prc) (^^sub m prc) 0 + =+ ^= g %- abs:si :: enforce min. exp + ?: =(den %i) --0 + ?: =((cmp:si e.a emn) -1) (dif:si emn e.a) --0 + (max f g) + =^ 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) :: expand + :: + =. a %- unj + ?- 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) :: halfway rounds 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.a [%f & zer] + :: + ?: =(den %i) [%f & a] + ?: =((cmp:si emx e.a) -1) [%i &] [%f & a] :: enforce max. exp + :: + ++ drg :: dragon4 + |= [a=[e=@s a=@u]] ^- [@s @u] + =. a ?: (^^lth (met 0 a.a) prc) (xpd a) 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) + =+ m=(lsh 0 ?:((syn:si e.a) (abs:si e.a) 0) 1) + =+ [k=--0 q=(^^div (^^add s 9) 10)] + |- ?: (^^lth r q) + %= $ + k (dif:si k --1) + r (^^mul r 10) + m (^^mul m 10) + == + |- ?: (^gte (^^add (^^mul r 2) m) (^^mul s 2)) + $(s (^^mul s 10), k (sum:si k --1)) + =+ [u=0 o=0] + |- => %= . + k (dif:si k --1) + u (^^div (^^mul r 10) s) + r (mod (^^mul r 10) s) + m (^^mul m 10) + == + ?> (^^lth u 10) + =+ l=(^^lth (^^mul r 2) m) + =+ ^= h + ?| (^^lth (^^mul s 2) m) + (^gth (^^mul r 2) (^^sub (^^mul s 2) m)) + == + ?: &(!l !h) + $(o (^^add (^^mul o 10) u)) + =+ q=|(&(!l h) &(=(l h) (^gte (^^mul r 2) s))) + =. o (^^add (^^mul o 10) ?:(q +(u) u)) + [k o] + :: + ++ pow :: a^b + |= [a=@ b=@] + ?: =(b 0) 1 + |- ?: =(b 1) a + =+ c=$(b (^^div b 2)) + =+ d=(^^mul c c) + ?: =((end 0 1 b) 1) + (^^mul d a) + d + :: + ++ fac :: b! / a! + |= [a=@ b=@] + =+ x=(^^sub b a) + ?: =(x 0) 1 + ?: =(x 1) b + ?: =(x 2) (^^mul b (dec b)) + =+ y=(^^div (^^add a b) 2) + (^^mul $(b y) $(a y)) + :: + ++ bnd + |= [a=fn b=fn] ^- (unit fn) + =+ x=(^add a b) + =+ y=(^sub a b) + ?: =(x y) [~ x] ~ + :: + ++ chb :: l <= a <= h + |= [a=fn l=fn h=fn] ^- ? + &((fall (^lte l a) |) (fall (^lte a h) |)) + :: + ++ ned + |= [a=fn] ^- [%f s=? e=@s a=@u] + ?: ?=([%f *] a) a + ~| %need-float !! + :: + ++ cmd + |= [a=@u b=@u] ^- @s + =+ c=(^^div a b) + =+ d=(mod a b) + =+ e=(^^mul d 2) + =+ ^= f + ?: (^^lth e b) c + ?. =(e b) +(c) + ?~((end 0 1 c) c +(c)) + (dif:si (sun:si a) (sun:si (^^mul b f))) + :: + ++ rem + |= [a=fn b=fn] :: a cmod b + =. b (abs b) + ?: |(?=([%n *] a) ?=([%n *] b)) [%n ~] + ?: |(?=([%i *] a) ?=([%i *] b)) [%n ~] + ?~ a.a [%f & zer:m] ?~ a.b [%n ~] + |- ?. s.a =.(r swr (fli $(s.a &))) + =+ [ma=(met 0 a.a) mb=(met 0 a.b)] + =+ ^= q + ?. =((cmp:si e.a e.b) -1) --0 + (dif:si e.b e.a) + =+ al=a(a (end 0 (abs:si q) a.a)) + =+ ah=a(a (rsh 0 (abs:si q) a.a), e (sum:si e.a q)) + =+ w=(abs:si (dif:si e.ah e.b)) + =+ z=(mod (bex w) a.b) + =+ x=(old:si (cmd:m (^^mul a.ah z) a.b)) + =+ r=`fn`[%f -.x e.b +.x] + ?: |((need (^lth r b(e (dif:si e.b --1)))) =(a.al 0)) + (^add r al) + (^sub al r) + :: + ++ shf + |= [a=fn b=@s] + ?: |(?=([%n *] a) ?=([%i *] a)) a + a(e (sum:si e.a b)) + :: + ++ cmp2 :: impl. of cmp2 as in + |= [a=fn b=fn] ^- (unit ,@s) :: mpfr's algorithms manual + ?> &(?=([%f *] a) ?=([%f *] b)) :: XX unoptimized + ?~ a.a !! + =+ c=(ned (ead a (fli b))) + ?~ a.c ~ :- ~ (dif:si (ibl +>.a) (ibl +>.b)) + :: + ++ swr ?+(r r %d %u, %u %d) + ++ prc ?>((^gth p 1) p) + ++ mxp 20.000 :: max precision for some stuff + ++ den d + ++ emn v + ++ emm (sum:si emn (sun:si (dec prc))) + ++ emx (sum:si emn (sun:si w)) + ++ spd [emn 1] :: smallest "denormal" + ++ spn [emn (bex (dec prc))] :: smallest "normal" + ++ lfn [emx (fil 0 prc 1)] :: largest + ++ zer [--0 0] :: zero -- - :::::::::::: - ++ add |= [b=@u p=@u n=[s=? e=@s a=@u] m=[s=? e=@s a=@u]] - ^- [s=? e=@s a=@u] - =+ g=(gar:te:fl b n m) - ?: ?=(^ g) - u.g - ?: (zer:te:fl b p n) - m - ?: (zer:te:fl b p m) - n - ?: &(!s.n !s.m) :: both negative - =+ r=$(s.n %.y, s.m %.y) - [s=%.n e=e.r a=a.r] - ?. &(s.n s.m) :: if not both positive - (sub b p n [s=!s.m e=e.m a=a.m]) :: is actually sub - ?: =(-1 (cmp:si e.n e.m)) :: guarantee e.n > e.m - $(n m, m n) - =+ dif=(abs:si (dif:si e.n e.m)) :: always pos - =+ a2=(lsh 0 dif a.n) :: p+1+dif bits - =+ a3=(^add a.m a2) :: at least p+1+dif bits - =+ dif2=(^sub (met 0 a3) (met 0 a2)) :: (met 0 a3) > (met 0 a2) - =+ e2=(sum:si (sun:si dif2) e.n) - (pro:te:fl b p [s=|(s.n s.m) e=e2 a=(lia p a3)]) - - ++ sub |= [b=@u p=@u n=[s=? e=@s a=@u] m=[s=? e=@s a=@u]] - ^- [s=? e=@s a=@u] - =+ g=(gar:te:fl b n m) - ?: ?=(^ g) - u.g - ?: |((zer:te:fl b p n) (zer:te:fl b p m)) - (add b p n m(s !s.m)) :: why not - ?: &(!s.n s.m) :: -a-b - (add b p n [s=%.n e.m a.m]) :: add handles negative case - ?: &(s.n !s.m) :: a+b - (add b p n [s=%.y e.m a.m]) :: is actually add - ?. |(=(--1 (cmp:si e.n e.m)) &(=(e.n e.m) (^gte a.n a.m))) :: n > m - $(n m(s !s.m), m n(s !s.n)) - =+ dif=(abs:si (dif:si e.n e.m)) - =+ a2=(lsh 0 dif a.n) :: p+1+dif bits - =+ a3=(^sub a2 a.m) :: assume m < 0 for now - =+ dif2=(^sub (met 0 a2) (met 0 a3)) :: (met 0 a2) > (met 0 a3) - (pro:te:fl b p [s=s.n e=(dif:si e.n (sun:si dif2)) a=(lia p a3)]) :: n > m => s=s.n - - ++ mul |= [b=@u p=@u n=[s=? e=@s a=@u] m=[s=? e=@s a=@u]] ^- [s=? e=@ a=@] - =+ g=(gar:te:fl b n m) - ?: ?=(^ g) - u.g - ?: |((zer:te:fl b p n) (zer:te:fl b p m)) - (szer:vl:fl b p =(s.n s.m)) - =+ a2=(^mul a.n a.m) - :: =+ a3=(mix (lsh 0 (^mul p 2) 1) (end 0 (^mul p 2) a2)) - =+ e2=(met 0 (rsh 0 (^add 1 (^mul p 2)) a2)) - :: =+ a4=(rnd p (rsh 0 e2 a3)) - =+ a4=(lia p a2) - =+ s2==(s.n s.m) - (pro:te:fl b p [s=s2 e=:(sum:si e.n e.m (sun:si e2)) a=a4]) - - ++ div |= [b=@u p=@u n=[s=? e=@s a=@u] m=[s=? e=@s a=@u]] ^- [s=? e=@ a=@] - =+ g=(gar:te:fl b n m) - ?: &((zer:te:fl b p n) (zer:te:fl b p m)) - (qnan:vl:fl b p %.n) - ?: (zer:te:fl b p n) - (szer:vl:fl b p =(s.n s.m)) - ?: (zer:te:fl b p m) - (inft:vl:fl b p =(s.n s.m)) - =+ c=(lia p (^div (lsh 0 (^mul p 3) a.n) a.m)) - ?: (^gte a.n a.m) - (pro:te:fl b p [s==(s.n s.m) e=(dif:si e.n e.m) a=c]) - (pro:te:fl b p [s==(s.n s.m) e=(dif:si (dif:si e.n e.m) (sun:si 1)) a=c]) - - ++ lte |= [n=[s=? e=@s a=@u] m=[s=? e=@s a=@u]] ^- ? - ?: =(%.n n) - ?: =(%.n m) - ?: &(=(e.n a.n) =(a.n a.m)) - %.y - !$(s.n %.y, s.m %.y) - %.y - ?: =(%.y m) - %.n - ?: =(-1 (cmp:si e.n e.m)) - %.y - ?: =(--1 (cmp:si e.n e.m)) - %.n - (^lte a.n a.m) - - ++ lth |= [n=[s=? e=@s a=@u] m=[s=? e=@s a=@u]] ^- ? - ?: =(%.n n) - ?: =(%.n m) - ?: &(=(e.n a.n) =(a.n a.m)) - %.n - !$(s.n %.y, s.m %.y) - %.y - ?: =(%.y m) - %.n - ?: =(-1 (cmp:si e.n e.m)) - %.y - ?: =(--1 (cmp:si e.n e.m)) - %.n - (^lth a.n a.m) - - ++ gte |= [n=[s=? e=@s a=@u] m=[s=? e=@s a=@u]] ^- ? - (lth m n) - - ++ gth |= [n=[s=? e=@s a=@u] m=[s=? e=@s a=@u]] ^- ? - (lte m n) -- :: -++ rd :: core for @rd - ~% %rd + ~ +++ ff :: ieee754 format + |_ [[w=@u p=@u b=@s f=?] r=?(%n %u %d %z %a)] + :: + ++ sz +((^add w p)) + ++ sb (bex (^add w p)) + :: + ++ pa + =+ i=(dif:si --1 b) + =+ q=fl + q(p +(p), v i, w (^sub (bex w) 3), d ?:(f %f %d), r r) + :: + ++ sea + |= [a=@r] ^- fn + =+ f=(cut 0 [0 p] a) + =+ e=(cut 0 [p w] a) + =+ s==(0 (cut 0 [(^add p w) 1] a)) + ?: =(e 0) + ?: =(f 0) [%f s --0 0] [%f s (dif:si --1 b) f] + ?: =(e (fil 0 w 1)) + ?: =(f 0) [%i s] [%n ~] + =+ q=(dif:si (sun:si e) (sum:si b (sun:si p))) + =+ r=(^add f (bex p)) + [%f s q r] + :: + ++ bit |= [a=fn] (bif (rou:pa a)) + :: + ++ 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 (dif:si --1 b)) + ?> (^lth ma +(p)) + ?: s.a `@r`a.a (^add a.a sb) + =+ q=(sum:si (sum:si e.a (sun:si p)) b) + =+ r=(^add (lsh 0 p (abs:si q)) (end 0 p a.a)) + ?: s.a r (^add r sb) + :: + ++ sig + |= [a=@r] ^- ? + =(0 (cut 0 [(^add p w) 1] a)) + :: + ++ exp + |= [a=@r] ^- @s + (dif:si (sun:si (cut 0 [p w] a)) b) + :: + ++ add |= [a=@r b=@r] (bif (add:pa (sea a) (sea b))) + ++ sub |= [a=@r b=@r] (bif (sub:pa (sea a) (sea b))) + ++ mul |= [a=@r b=@r] (bif (mul:pa (sea a) (sea b))) + ++ div |= [a=@r b=@r] (bif (div:pa (sea a) (sea b))) + ++ fma |= [a=@r b=@r c=@r] (bif (fma:pa (sea a) (sea b) (sea c))) + ++ sqt |= [a=@r] (bif (sqt:pa (sea a))) + ++ sun |= [a=@u] (bit [%f & --0 a]) + ++ san |= [a=@s] (bit [%f (syn:si a) --0 (abs:si a)]) + ++ lth |= [a=@r b=@r] (lth:pa (sea a) (sea b)) + ++ lte |= [a=@r b=@r] (lte:pa (sea a) (sea b)) + ++ equ |= [a=@r b=@r] (equ:pa (sea a) (sea b)) + ++ gte |= [a=@r b=@r] (gte:pa (sea a) (sea b)) + ++ gth |= [a=@r b=@r] (gth:pa (sea a) (sea b)) + ++ drg |= [a=@r] (drg:pa (sea a)) + ++ grd |= [a=dn] (bif (grd:pa a)) + -- +:: +++ rlyd |= a=@rd ^- dn (drg:rd a) +++ rlys |= a=@rs ^- dn (drg:rs a) +++ rlyh |= a=@rh ^- dn (drg:rh a) +++ rlyq |= a=@rq ^- dn (drg:rq a) +++ ryld |= a=dn ^- @rd (grd:rd a) +++ ryls |= a=dn ^- @rs (grd:rs a) +++ rylh |= a=dn ^- @rh (grd:rh a) +++ rylq |= a=dn ^- @rq (grd:rq a) +:: +++ rd + =+ ma==>(ff .(w 11, p 52, b --1.023, f %.n, r %n)) |% - ++ mlen 52 :: mantissa bits - ++ elen 11 :: exponent bits - ++ bias 1.023 :: exponent bias - ++ dlen 14 :: ~=log_10(2^mlen) - :: Convert a sign/exp/ari cell into 64 bit atom - ++ bit |= a=[s=? e=@s a=@u] - =+ a2=(lia:fl mlen a.a) - =+ b=(ira:fl a2) - ::=+ c=(lsh 0 (^sub 52 (met 0 b)) b) - %+ can 0 - [[mlen b] [[elen (abs:si (sum:si (sun:si bias) e.a))] [[1 `@`s.a] ~]]] - :: Sign of an @rd - ++ sig |= [a=@rd] ^- ? - =(0 (rsh 0 (^add mlen elen) a)) - :: Exponent of an @rd - ++ exp |= [a=@rd] ^- @s - (dif:si (sun:si (rsh 0 mlen (end 0 (^add elen mlen) a))) (sun:si bias)) - :: Fraction of an @rd (binary) - ++ fac |= [a=@rd] ^- @u - (fre:fl dlen (sea a)) - :: Whole - ++ hol |= [a=@rd] ^- @u - (hol:fl mlen (sea a)) - :: Convert to sign/exp/ari form - ++ sea |= a=@rd ^- [s=? e=@s a=@u] - (pro:te:fl bias mlen [s=(sig a) e=(exp a) a=(ari:fl mlen (end 0 mlen a))]) - ++ err |= a=@rd ^- (unit tape) - (err:te:fl bias mlen (sea a)) - - :::::::::::: - ++ sun ~/ %sun - |= a=@u ^- @rd - (bit (cof:fl mlen bias %.y a 0 0 ~)) - - ++ add ~/ %add - |= [a=@rd b=@rd] ^- @rd - (bit (add:fl bias mlen (sea a) (sea b))) - - ++ sub ~/ %sub - |= [a=@rd b=@rd] ^- @rd - (bit (sub:fl bias mlen (sea a) (sea b))) - - ++ mul ~/ %mul - |= [a=@rd b=@rd] ^- @rd - (bit (mul:fl bias mlen (sea a) (sea b))) - - ++ div ~/ %div - |= [a=@rd b=@rd] ^- @rd - (bit (div:fl bias mlen (sea a) (sea b))) - - ++ lte ~/ %lte - |= [a=@rd b=@rd] ^- ? - (lte:fl (sea a) (sea b)) - - ++ lth ~/ %lth - |= [a=@rd b=@rd] ^- ? - (lth:fl (sea a) (sea b)) - - ++ gte ~/ %gte - |= [a=@rd b=@rd] ^- ? - (gte:fl (sea a) (sea b)) - - ++ gth ~/ %gth - |= [a=@rd b=@rd] ^- ? - (gth:fl (sea a) (sea b)) - - ++ max |= [a=@rd b=@rd] ^- @rd - ?: (gth a b) - a - b - - ++ min |= [a=@rd b=@rd] ^- @rd - ?: (lth a b) - a - b - - ++ bex |= a=@s ^- @rd - (bit [s=%.y e=a a=(ari:fl mlen 0)]) - - ++ ipow |= [exp=@s n=@rd] - ^- @rd - ?: =(0 (mod exp 2)) - ?: =(0 exp) - n - (mul .~10 $(exp (^sub exp 2))) - ?: =(1 exp) - (div n .~10) - (div $(exp (^sub exp 2)) .~10) + ++ sea + |= [a=@rd] (sea:ma a) + ++ bit + |= [a=fn] ^- @rd (bit:ma a) + ++ sig + |= [a=@rd] (sig:ma a) + ++ exp + |= [a=@rd] (exp:ma a) + ++ add + |= [a=@rd b=@rd] ^- @rd (add:ma a b) + ++ sub + |= [a=@rd b=@rd] ^- @rd (sub:ma a b) + ++ mul + |= [a=@rd b=@rd] ^- @rd (mul:ma a b) + ++ div + |= [a=@rd b=@rd] ^- @rd (div:ma a b) + ++ fma + |= [a=@rd b=@rd c=@rd] ^- @rd (fma:ma a b c) + ++ sqt + |= [a=@rd] ^- @rd (sqt:ma a) + ++ sun + |= [a=@u] ^- @rd (sun:ma a) + ++ san + |= [a=@s] ^- @rd (san:ma a) + ++ lth + |= [a=@rd b=@rd] (lth:ma a b) + ++ lte + |= [a=@rd b=@rd] (lte:ma a b) + ++ equ + |= [a=@rd b=@rd] (equ:ma a b) + ++ gte + |= [a=@rd b=@rd] (gte:ma a b) + ++ gth + |= [a=@rd b=@rd] (gth:ma a b) + ++ drg + |= [a=@rd] (drg:ma a) + ++ grd + |= [a=dn] (grd:ma a) + -- +:: +++ rs + =+ ma==>(ff .(w 8, p 23, b --127, f %.n, r %n)) + |% + ++ sea + |= [a=@rs] (sea:ma a) + ++ bit + |= [a=fn] ^- @rs (bit:ma a) + ++ sig + |= [a=@rs] (sig:ma a) + ++ exp + |= [a=@rs] (exp:ma a) + ++ add + |= [a=@rs b=@rs] ^- @rs (add:ma a b) + ++ sub + |= [a=@rs b=@rs] ^- @rs (sub:ma a b) + ++ mul + |= [a=@rs b=@rs] ^- @rs (mul:ma a b) + ++ div + |= [a=@rs b=@rs] ^- @rs (div:ma a b) + ++ fma + |= [a=@rs b=@rs c=@rs] ^- @rs (fma:ma a b c) + ++ sqt + |= [a=@rs] ^- @rs (sqt:ma a) + ++ sun + |= [a=@u] ^- @rs (sun:ma a) + ++ san + |= [a=@s] ^- @rs (san:ma a) + ++ lth + |= [a=@rs b=@rs] (lth:ma a b) + ++ lte + |= [a=@rs b=@rs] (lte:ma a b) + ++ equ + |= [a=@rs b=@rs] (equ:ma a b) + ++ gte + |= [a=@rs b=@rs] (gte:ma a b) + ++ gth + |= [a=@rs b=@rs] (gth:ma a b) + ++ drg + |= [a=@rs] (drg:ma a) + ++ grd + |= [a=dn] (grd:ma a) + -- +:: +++ rh + =+ ma==>(ff .(w 5, p 10, b --15, f %.n, r %n)) + |% + ++ sea + |= [a=@rh] (sea:ma a) + ++ bit + |= [a=fn] ^- @rh (bit:ma a) + ++ sig + |= [a=@rh] (sig:ma a) + ++ exp + |= [a=@rh] (exp:ma a) + ++ add + |= [a=@rh b=@rh] ^- @rh (add:ma a b) + ++ sub + |= [a=@rh b=@rh] ^- @rh (sub:ma a b) + ++ mul + |= [a=@rh b=@rh] ^- @rh (mul:ma a b) + ++ div + |= [a=@rh b=@rh] ^- @rh (div:ma a b) + ++ fma + |= [a=@rh b=@rh c=@rh] ^- @rh (fma:ma a b c) + ++ sqt + |= [a=@rh] ^- @rh (sqt:ma a) + ++ sun + |= [a=@u] ^- @rh (sun:ma a) + ++ san + |= [a=@s] ^- @rh (san:ma a) + ++ lth + |= [a=@rh b=@rh] (lth:ma a b) + ++ lte + |= [a=@rh b=@rh] (lte:ma a b) + ++ equ + |= [a=@rh b=@rh] (equ:ma a b) + ++ gte + |= [a=@rh b=@rh] (gte:ma a b) + ++ gth + |= [a=@rh b=@rh] (gth:ma a b) + ++ drg + |= [a=@rh] (drg:ma a) + ++ grd + |= [a=dn] (grd:ma a) + -- +:: +++ rq + =+ ma==>(ff .(w 15, p 112, b --16.383, f %.n, r %n)) + |% + ++ sea + |= [a=@rq] (sea:ma a) + ++ bit + |= [a=fn] ^- @rq (bit:ma a) + ++ sig + |= [a=@rq] (sig:ma a) + ++ exp + |= [a=@rq] (exp:ma a) + ++ add + |= [a=@rq b=@rq] ^- @rq (add:ma a b) + ++ sub + |= [a=@rq b=@rq] ^- @rq (sub:ma a b) + ++ mul + |= [a=@rq b=@rq] ^- @rq (mul:ma a b) + ++ div + |= [a=@rq b=@rq] ^- @rq (div:ma a b) + ++ fma + |= [a=@rq b=@rq c=@rq] ^- @rq (fma:ma a b c) + ++ sqt + |= [a=@rq] ^- @rq (sqt:ma a) + ++ sun + |= [a=@u] ^- @rq (sun:ma a) + ++ san + |= [a=@s] ^- @rq (san:ma a) + ++ lth + |= [a=@rq b=@rq] (lth:ma a b) + ++ lte + |= [a=@rq b=@rq] (lte:ma a b) + ++ equ + |= [a=@rq b=@rq] (equ:ma a b) + ++ gte + |= [a=@rq b=@rq] (gte:ma a b) + ++ gth + |= [a=@rq b=@rq] (gth:ma a b) + ++ drg + |= [a=@rq] (drg:ma a) + ++ grd + |= [a=dn] (grd:ma a) -- :::::::::::::::::::::::::::::::::::::::::::::::::::::::::: :: section 2cH, urbit time :: @@ -3539,11 +4311,7 @@ :: %r ?+ hay (z-co q.p.lot) - %d - =+ r=(rlyd q.p.lot) - ?~ e.r - ['.' '~' (r-co r)] - ['.' '~' u.e.r] + %d ['.' '~' (r-co (rlyd q.p.lot))] %h ['.' '~' '~' (r-co (rlyh q.p.lot))] %q ['.' '~' '~' '~' (r-co (rlyq q.p.lot))] %s ['.' (r-co (rlys q.p.lot))] @@ -3582,13 +4350,20 @@ ++ c-co (em-co [58 1] |=([? b=@ c=tape] [~(c ne b) c])) ++ d-co |=(min=@ (em-co [10 min] |=([? b=@ c=tape] [~(d ne b) c]))) ++ r-co - |= [syn=? nub=@ der=@ ign=(unit tape) ne=?] - => .(rex ['.' (t-co ((d-co 1) der) ne)]) - => .(rex ((d-co 1) nub)) - ?:(syn rex ['-' rex]) - ++ t-co |= [a=tape n=?] ^- tape - ?: n a - ?~ a ~|(%empty-frac !!) t.a + |= [a=dn] + ?: ?=([%i *] a) (weld ?:(s.a "inf" "-inf") rex) + ?: ?=([%n *] a) (weld "nan" rex) + =+ ^= e %+ ed-co [10 1] + |= [a=? b=@ c=tape] + ?: a [~(d ne b) '.' c] + [~(d ne b) c] + =+ ^= f + =>(.(rex ~) (e a.a)) + =. e.a (sum:si e.a (sun:si +.f)) + =+ b=?:((syn:si e.a) "e" "e-") + => .(rex (weld b ((d-co 1) (abs:si e.a)))) + => .(rex (weld -.f rex)) + ?:(s.a rex ['-' rex]) :: ++ s-co |= esc=(list ,@) ^- tape @@ -3597,7 +4372,7 @@ rex :- '.' =>(.(rex $(esc t.esc)) ((x-co 4) i.esc)) - :: + :: ++ v-co |=(min=@ (em-co [32 min] |=([? b=@ c=tape] [~(v ne b) c]))) ++ w-co |=(min=@ (em-co [64 min] |=([? b=@ c=tape] [~(w ne b) c]))) ++ x-co |=(min=@ (em-co [16 min] |=([? b=@ c=tape] [~(x ne b) c]))) @@ -3618,6 +4393,22 @@ rex (par =(0 dar) rad rex) == :: + ++ ed-co + |= [[bas=@ min=@] [par=$+([? @ tape] tape)]] + =+ [fir=& cou=0] + |= hol=@ + ^- [tape @] + ?: &(=(0 hol) =(0 min)) + [rex (dec cou)] + =+ [rad=(mod hol bas) dar=(div hol bas)] + %= $ + min ?:(=(0 min) 0 (dec min)) + hol dar + rex (par &(=(0 dar) !fir) rad rex) + fir | + cou +(cou) + == + :: ++ ox-co |= [[bas=@ gop=@] dug=$+(@ @)] %+ em-co @@ -3752,13 +4543,20 @@ == ++ royl ~+ - =+ ^= zer - (cook lent (star (just '0'))) + =+ ^= moo + |= a=tape + :- (lent a) + (scan a (bass 10 (plus sid:ab))) =+ ^= voy %+ cook royl-cell ;~ plug ;~(pose (cold | hep) (easy &)) - ;~(plug dim:ag ;~(pose ;~(pfix dot ;~(plug zer dim:ag)) (easy [0 0]))) + ;~ plug dim:ag + ;~ pose + ;~(pfix dot (cook moo (plus (shim '0' '9')))) + (easy [0 0]) + == + == ;~ pose ;~ pfix (just 'e') @@ -3771,16 +4569,18 @@ (stag %rh (cook rylh ;~(pfix ;~(plug sig sig) voy))) (stag %rq (cook rylq ;~(pfix ;~(plug sig sig sig) voy))) (stag %rd (cook ryld ;~(pfix sig voy))) - :: (stag %rs (cook ryls voy)) + (stag %rs (cook ryls voy)) == + :: ++ royl-cell |= [a=? b=[c=@ d=@ e=@] f=(unit ,[h=? i=@])] - ^- [? @ @ @ (unit ,@s)] - ?~ f - [a c.b d.b e.b ~] - ?: h.u.f - [a c.b d.b e.b [~ (mul i.u.f 2)]] - [a c.b d.b e.b [~ (dec (mul i.u.f 2))]] + ^- dn + =+ ^= h + (dif:si ?~(f --0 (new:si u.f)) (sun:si d.b)) + |- ?. =(d.b 0) + $(c.b (mul c.b 10), d.b (dec d.b)) + [%d a h (add c.b e.b)] + :: ++ tash ~+ =+ ^= neg @@ -3793,6 +4593,7 @@ ;~(pfix hep (cook |=(a=dime (neg & a)) bisk)) == == + :: ++ twid ~+ ;~ pose From 8a7c3cfd60b90e754afcd4af096352e30012ae96 Mon Sep 17 00:00:00 2001 From: Max G Date: Sun, 12 Jul 2015 20:37:45 +0300 Subject: [PATCH 02/20] ma to arm --- arvo/hoon.hoon | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/arvo/hoon.hoon b/arvo/hoon.hoon index 37351de2be..b52476a801 100644 --- a/arvo/hoon.hoon +++ b/arvo/hoon.hoon @@ -2270,8 +2270,9 @@ ++ rylq |= a=dn ^- @rq (grd:rq a) :: ++ rd - =+ ma==>(ff .(w 11, p 52, b --1.023, f %.n, r %n)) |% + ++ ma + =>(ff .(w 11, p 52, b --1.023, f %.n, r %n)) ++ sea |= [a=@rd] (sea:ma a) ++ bit @@ -2313,8 +2314,9 @@ -- :: ++ rs - =+ ma==>(ff .(w 8, p 23, b --127, f %.n, r %n)) |% + ++ ma + =>(ff .(w 8, p 23, b --127, f %.n, r %n)) ++ sea |= [a=@rs] (sea:ma a) ++ bit @@ -2356,8 +2358,9 @@ -- :: ++ rh - =+ ma==>(ff .(w 5, p 10, b --15, f %.n, r %n)) |% + ++ ma + =>(ff .(w 5, p 10, b --15, f %.n, r %n)) ++ sea |= [a=@rh] (sea:ma a) ++ bit @@ -2399,8 +2402,9 @@ -- :: ++ rq - =+ ma==>(ff .(w 15, p 112, b --16.383, f %.n, r %n)) |% + ++ ma + =>(ff .(w 15, p 112, b --16.383, f %.n, r %n)) ++ sea |= [a=@rq] (sea:ma a) ++ bit From e07da94e9d1873135c32a289fe1134cdd1c3d6c6 Mon Sep 17 00:00:00 2001 From: Max G Date: Sun, 12 Jul 2015 21:56:29 +0300 Subject: [PATCH 03/20] ieee754 fix --- arvo/hoon.hoon | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/arvo/hoon.hoon b/arvo/hoon.hoon index b52476a801..c563331651 100644 --- a/arvo/hoon.hoon +++ b/arvo/hoon.hoon @@ -2200,7 +2200,7 @@ ++ sb (bex (^add w p)) :: ++ pa - =+ i=(dif:si --1 b) + =+ i=(dif:si (dif:si --1 b) (sun:si p)) =+ q=fl q(p +(p), v i, w (^sub (bex w) 3), d ?:(f %f %d), r r) :: From 95bb43c7d7e14b45d6a1c3947301952e8acf209a Mon Sep 17 00:00:00 2001 From: Max G Date: Mon, 13 Jul 2015 00:59:10 +0300 Subject: [PATCH 04/20] nan, inf parser --- arvo/hoon.hoon | 42 ++++++++++++++++++++++++++++++++---------- 1 file changed, 32 insertions(+), 10 deletions(-) diff --git a/arvo/hoon.hoon b/arvo/hoon.hoon index c563331651..a6c9cc139b 100644 --- a/arvo/hoon.hoon +++ b/arvo/hoon.hoon @@ -1314,6 +1314,10 @@ ?: |(=(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:m] + %- |= [a=fn] + ?. ?=([%f *] a) a + ?. =(a.a 0) a + [%f !=(r %d) zer:m] ?: =(s.a s.b) ?: s.a (add:m +>.a +>.b |) =.(r swr:m (fli (add:m +>.a +>.b |))) @@ -4552,23 +4556,37 @@ :- (lent a) (scan a (bass 10 (plus sid:ab))) =+ ^= voy - %+ cook royl-cell + %+ cook royl-cell + ;~ pose ;~ plug - ;~(pose (cold | hep) (easy &)) + (easy %f) + ;~ pose (cold | hep) (easy &) == ;~ plug dim:ag ;~ pose ;~(pfix dot (cook moo (plus (shim '0' '9')))) (easy [0 0]) == - == - ;~ pose - ;~ pfix - (just 'e') - (cook some ;~(plug ;~(pose (cold | hep) (easy &)) dim:ag)) + ;~ pose + ;~ pfix + (just 'e') + ;~(plug ;~(pose (cold | hep) (easy &)) dim:ag) + == + (easy [& 0]) == - (easy ~) == == + ;~ plug + (easy %i) + ;~ sfix + ;~ pose (cold | hep) (easy &) == + (jest 'inf') + == + == + ;~ plug + (easy %n) + (cold ~ (jest 'nan')) + == + == ;~ pose (stag %rh (cook rylh ;~(pfix ;~(plug sig sig) voy))) (stag %rq (cook rylq ;~(pfix ;~(plug sig sig sig) voy))) @@ -4577,10 +4595,14 @@ == :: ++ royl-cell - |= [a=? b=[c=@ d=@ e=@] f=(unit ,[h=? i=@])] + |= $? [%f a=? b=[c=@ [d=@ e=@] f=? i=@]] + [%i a=?] + [%n ~] + == ^- dn + ?. ?=([%f *] +<) +< =+ ^= h - (dif:si ?~(f --0 (new:si u.f)) (sun:si d.b)) + (dif:si (new:si f.b i.b) (sun:si d.b)) |- ?. =(d.b 0) $(c.b (mul c.b 10), d.b (dec d.b)) [%d a h (add c.b e.b)] From f28dd639e7c106a37d5a7e1a8e8c24bf87d8c7dd Mon Sep 17 00:00:00 2001 From: Max G Date: Mon, 13 Jul 2015 02:45:49 +0300 Subject: [PATCH 05/20] trivial --- arvo/hoon.hoon | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/arvo/hoon.hoon b/arvo/hoon.hoon index a6c9cc139b..a179eb121c 100644 --- a/arvo/hoon.hoon +++ b/arvo/hoon.hoon @@ -4367,9 +4367,9 @@ [~(d ne b) c] =+ ^= f =>(.(rex ~) (e a.a)) - =. e.a (sum:si e.a (sun:si +.f)) + =. e.a (sum:si e.a (sun:si (dec +.f))) =+ b=?:((syn:si e.a) "e" "e-") - => .(rex (weld b ((d-co 1) (abs:si e.a)))) + => .(rex ?~(e.a rex (weld b ((d-co 1) (abs:si e.a))))) => .(rex (weld -.f rex)) ?:(s.a rex ['-' rex]) :: @@ -4407,7 +4407,7 @@ |= hol=@ ^- [tape @] ?: &(=(0 hol) =(0 min)) - [rex (dec cou)] + [rex cou] =+ [rad=(mod hol bas) dar=(div hol bas)] %= $ min ?:(=(0 min) 0 (dec min)) From 9cce1ac1908feda48f3ee9144157378d029dea45 Mon Sep 17 00:00:00 2001 From: Anton Dyudin Date: Tue, 14 Jul 2015 17:31:00 -0700 Subject: [PATCH 06/20] more general css url fix --- pub/talk/src/css/fonts.styl | 28 ++++++++++++++-------------- pub/talk/src/css/main.css | 28 ++++++++++++++-------------- pub/tree/src/css/fonts.styl | 24 ++++++++++++------------ pub/tree/src/css/main.css | 24 ++++++++++++------------ 4 files changed, 52 insertions(+), 52 deletions(-) diff --git a/pub/talk/src/css/fonts.styl b/pub/talk/src/css/fonts.styl index 8a1d89755e..abfedf60ed 100644 --- a/pub/talk/src/css/fonts.styl +++ b/pub/talk/src/css/fonts.styl @@ -1,84 +1,84 @@ @font-face { font-family: "bau"; - src: url("https://storage.googleapis.com/urbit-extra/bau.woff"); + src: url("//storage.googleapis.com/urbit-extra/bau.woff"); font-weight: 400; font-style: normal; } @font-face { font-family: "bau"; - src: url("https://storage.googleapis.com/urbit-extra/bau-italic.woff"); + src: url("//storage.googleapis.com/urbit-extra/bau-italic.woff"); font-weight: 400; font-style: italic; } @font-face { font-family: "bau"; - src: url("https://storage.googleapis.com/urbit-extra/bau-medium.woff"); + src: url("//storage.googleapis.com/urbit-extra/bau-medium.woff"); font-weight: 500; font-style: normal; } @font-face { font-family: "bau"; - src: url("https://storage.googleapis.com/urbit-extra/bau-mediumitalic.woff"); + src: url("//storage.googleapis.com/urbit-extra/bau-mediumitalic.woff"); font-weight: 500; font-style: italic; } @font-face { font-family: "bau"; - src: url("https://storage.googleapis.com/urbit-extra/bau-bold.woff"); + src: url("//storage.googleapis.com/urbit-extra/bau-bold.woff"); font-weight: 600; font-style: normal; } @font-face { font-family: "bau"; - src: url("https://storage.googleapis.com/urbit-extra/bau-bolditalic.woff"); + src: url("//storage.googleapis.com/urbit-extra/bau-bolditalic.woff"); font-weight: 600; font-style: italic; } @font-face { font-family: "bau"; - src: url("https://storage.googleapis.com/urbit-extra/bau-super.woff"); + src: url("//storage.googleapis.com/urbit-extra/bau-super.woff"); font-weight: 600; font-style: normal; } @font-face { font-family: "bau"; - src: url("https://storage.googleapis.com/urbit-extra/bau-superitalic.woff"); + src: url("//storage.googleapis.com/urbit-extra/bau-superitalic.woff"); font-weight: 600; font-style: italic; } @font-face { font-family: "scp"; - src: url("https://storage.googleapis.com/urbit-extra/scp-extralight.woff"); + src: url("//storage.googleapis.com/urbit-extra/scp-extralight.woff"); font-weight: 200; font-style: normal; } @font-face { font-family: "scp"; - src: url("https://storage.googleapis.com/urbit-extra/scp-light.woff"); + src: url("//storage.googleapis.com/urbit-extra/scp-light.woff"); font-weight: 300; font-style: normal; } @font-face { font-family: "scp"; - src: url("https://storage.googleapis.com/urbit-extra/scp-regular.woff"); + src: url("//storage.googleapis.com/urbit-extra/scp-regular.woff"); font-weight: 400; font-style: normal; } @font-face { font-family: "scp"; - src: url("https://storage.googleapis.com/urbit-extra/scp-medium.woff"); + src: url("//storage.googleapis.com/urbit-extra/scp-medium.woff"); font-weight: 500; font-style: normal; } @font-face { font-family: "scp"; - src: url("https://storage.googleapis.com/urbit-extra/scp-bold.woff"); + src: url("//storage.googleapis.com/urbit-extra/scp-bold.woff"); font-weight: 600; font-style: normal; } @font-face { font-family: "scp"; - src: url("https://storage.googleapis.com/urbit-extra/scp-black.woff"); + src: url("//storage.googleapis.com/urbit-extra/scp-black.woff"); font-weight: 700; font-style: normal; } \ No newline at end of file diff --git a/pub/talk/src/css/main.css b/pub/talk/src/css/main.css index 487c2a648b..77af2c8e74 100644 --- a/pub/talk/src/css/main.css +++ b/pub/talk/src/css/main.css @@ -1,84 +1,84 @@ @font-face { font-family: "bau"; - src: url("https://storage.googleapis.com/urbit-extra/bau.woff"); + src: url("//storage.googleapis.com/urbit-extra/bau.woff"); font-weight: 400; font-style: normal; } @font-face { font-family: "bau"; - src: url("https://storage.googleapis.com/urbit-extra/bau-italic.woff"); + src: url("//storage.googleapis.com/urbit-extra/bau-italic.woff"); font-weight: 400; font-style: italic; } @font-face { font-family: "bau"; - src: url("https://storage.googleapis.com/urbit-extra/bau-medium.woff"); + src: url("//storage.googleapis.com/urbit-extra/bau-medium.woff"); font-weight: 500; font-style: normal; } @font-face { font-family: "bau"; - src: url("https://storage.googleapis.com/urbit-extra/bau-mediumitalic.woff"); + src: url("//storage.googleapis.com/urbit-extra/bau-mediumitalic.woff"); font-weight: 500; font-style: italic; } @font-face { font-family: "bau"; - src: url("https://storage.googleapis.com/urbit-extra/bau-bold.woff"); + src: url("//storage.googleapis.com/urbit-extra/bau-bold.woff"); font-weight: 600; font-style: normal; } @font-face { font-family: "bau"; - src: url("https://storage.googleapis.com/urbit-extra/bau-bolditalic.woff"); + src: url("//storage.googleapis.com/urbit-extra/bau-bolditalic.woff"); font-weight: 600; font-style: italic; } @font-face { font-family: "bau"; - src: url("https://storage.googleapis.com/urbit-extra/bau-super.woff"); + src: url("//storage.googleapis.com/urbit-extra/bau-super.woff"); font-weight: 600; font-style: normal; } @font-face { font-family: "bau"; - src: url("https://storage.googleapis.com/urbit-extra/bau-superitalic.woff"); + src: url("//storage.googleapis.com/urbit-extra/bau-superitalic.woff"); font-weight: 600; font-style: italic; } @font-face { font-family: "scp"; - src: url("https://storage.googleapis.com/urbit-extra/scp-extralight.woff"); + src: url("//storage.googleapis.com/urbit-extra/scp-extralight.woff"); font-weight: 200; font-style: normal; } @font-face { font-family: "scp"; - src: url("https://storage.googleapis.com/urbit-extra/scp-light.woff"); + src: url("//storage.googleapis.com/urbit-extra/scp-light.woff"); font-weight: 300; font-style: normal; } @font-face { font-family: "scp"; - src: url("https://storage.googleapis.com/urbit-extra/scp-regular.woff"); + src: url("//storage.googleapis.com/urbit-extra/scp-regular.woff"); font-weight: 400; font-style: normal; } @font-face { font-family: "scp"; - src: url("https://storage.googleapis.com/urbit-extra/scp-medium.woff"); + src: url("//storage.googleapis.com/urbit-extra/scp-medium.woff"); font-weight: 500; font-style: normal; } @font-face { font-family: "scp"; - src: url("https://storage.googleapis.com/urbit-extra/scp-bold.woff"); + src: url("//storage.googleapis.com/urbit-extra/scp-bold.woff"); font-weight: 600; font-style: normal; } @font-face { font-family: "scp"; - src: url("https://storage.googleapis.com/urbit-extra/scp-black.woff"); + src: url("//storage.googleapis.com/urbit-extra/scp-black.woff"); font-weight: 700; font-style: normal; } diff --git a/pub/tree/src/css/fonts.styl b/pub/tree/src/css/fonts.styl index 0a3e76a4a0..505e2c388f 100644 --- a/pub/tree/src/css/fonts.styl +++ b/pub/tree/src/css/fonts.styl @@ -4,42 +4,42 @@ @font-face font-family "bau" - src url("https://storage.googleapis.com/urbit-extra/bau.woff") + src url("//storage.googleapis.com/urbit-extra/bau.woff") font-weight 400 font-style normal @font-face font-family "bau" - src url("https://storage.googleapis.com/urbit-extra/bau-italic.woff") + src url("//storage.googleapis.com/urbit-extra/bau-italic.woff") font-weight 400 font-style italic @font-face font-family "bau" - src url("https://storage.googleapis.com/urbit-extra/bau-medium.woff") + src url("//storage.googleapis.com/urbit-extra/bau-medium.woff") font-weight 500 font-style normal @font-face font-family "bau" - src url("https://storage.googleapis.com/urbit-extra/bau-mediumitalic.woff") + src url("//storage.googleapis.com/urbit-extra/bau-mediumitalic.woff") font-weight 500 font-style italic @font-face font-family "bau" - src url("https://storage.googleapis.com/urbit-extra/bau-bold.woff") + src url("//storage.googleapis.com/urbit-extra/bau-bold.woff") font-weight 600 font-style normal @font-face font-family "bau" - src url("https://storage.googleapis.com/urbit-extra/bau-bolditalic.woff") + src url("//storage.googleapis.com/urbit-extra/bau-bolditalic.woff") font-weight 600 font-style italic @font-face font-family "bau" - src url("https://storage.googleapis.com/urbit-extra/bau-super.woff") + src url("//storage.googleapis.com/urbit-extra/bau-super.woff") font-weight 600 font-style normal @font-face font-family "bau" - src url("https://storage.googleapis.com/urbit-extra/bau-superitalic.woff") + src url("//storage.googleapis.com/urbit-extra/bau-superitalic.woff") font-weight 600 font-style italic @@ -49,21 +49,21 @@ @font-face font-family "scp" - src url("https://storage.googleapis.com/urbit-extra/scp-extralight.woff") + src url("//storage.googleapis.com/urbit-extra/scp-extralight.woff") font-weight 200 font-style normal @font-face font-family "scp" - src url("https://storage.googleapis.com/urbit-extra/scp-light.woff") + src url("//storage.googleapis.com/urbit-extra/scp-light.woff") font-weight 300 font-style normal @font-face font-family "scp" - src url("https://storage.googleapis.com/urbit-extra/scp-regular.woff") + src url("//storage.googleapis.com/urbit-extra/scp-regular.woff") font-weight 400 font-style normal @font-face font-family "scp" - src url("https://storage.googleapis.com/urbit-extra/scp-medium.woff") + src url("//storage.googleapis.com/urbit-extra/scp-medium.woff") font-weight 500 font-style normal \ No newline at end of file diff --git a/pub/tree/src/css/main.css b/pub/tree/src/css/main.css index 76f13d7c75..9c8f641982 100644 --- a/pub/tree/src/css/main.css +++ b/pub/tree/src/css/main.css @@ -1,72 +1,72 @@ @font-face { font-family: "bau"; - src: url("https://storage.googleapis.com/urbit-extra/bau.woff"); + src: url("//storage.googleapis.com/urbit-extra/bau.woff"); font-weight: 400; font-style: normal; } @font-face { font-family: "bau"; - src: url("https://storage.googleapis.com/urbit-extra/bau-italic.woff"); + src: url("//storage.googleapis.com/urbit-extra/bau-italic.woff"); font-weight: 400; font-style: italic; } @font-face { font-family: "bau"; - src: url("https://storage.googleapis.com/urbit-extra/bau-medium.woff"); + src: url("//storage.googleapis.com/urbit-extra/bau-medium.woff"); font-weight: 500; font-style: normal; } @font-face { font-family: "bau"; - src: url("https://storage.googleapis.com/urbit-extra/bau-mediumitalic.woff"); + src: url("//storage.googleapis.com/urbit-extra/bau-mediumitalic.woff"); font-weight: 500; font-style: italic; } @font-face { font-family: "bau"; - src: url("https://storage.googleapis.com/urbit-extra/bau-bold.woff"); + src: url("//storage.googleapis.com/urbit-extra/bau-bold.woff"); font-weight: 600; font-style: normal; } @font-face { font-family: "bau"; - src: url("https://storage.googleapis.com/urbit-extra/bau-bolditalic.woff"); + src: url("//storage.googleapis.com/urbit-extra/bau-bolditalic.woff"); font-weight: 600; font-style: italic; } @font-face { font-family: "bau"; - src: url("https://storage.googleapis.com/urbit-extra/bau-super.woff"); + src: url("//storage.googleapis.com/urbit-extra/bau-super.woff"); font-weight: 600; font-style: normal; } @font-face { font-family: "bau"; - src: url("https://storage.googleapis.com/urbit-extra/bau-superitalic.woff"); + src: url("//storage.googleapis.com/urbit-extra/bau-superitalic.woff"); font-weight: 600; font-style: italic; } @font-face { font-family: "scp"; - src: url("https://storage.googleapis.com/urbit-extra/scp-extralight.woff"); + src: url("//storage.googleapis.com/urbit-extra/scp-extralight.woff"); font-weight: 200; font-style: normal; } @font-face { font-family: "scp"; - src: url("https://storage.googleapis.com/urbit-extra/scp-light.woff"); + src: url("//storage.googleapis.com/urbit-extra/scp-light.woff"); font-weight: 300; font-style: normal; } @font-face { font-family: "scp"; - src: url("https://storage.googleapis.com/urbit-extra/scp-regular.woff"); + src: url("//storage.googleapis.com/urbit-extra/scp-regular.woff"); font-weight: 400; font-style: normal; } @font-face { font-family: "scp"; - src: url("https://storage.googleapis.com/urbit-extra/scp-medium.woff"); + src: url("//storage.googleapis.com/urbit-extra/scp-medium.woff"); font-weight: 500; font-style: normal; } From d48a6d1869f94339f21cdb1001a7970521673100 Mon Sep 17 00:00:00 2001 From: Anton Dyudin Date: Wed, 15 Jul 2015 15:11:45 -0700 Subject: [PATCH 07/20] fixed ~ escaped . being unhandled in urx:ab --- arvo/hoon.hoon | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/arvo/hoon.hoon b/arvo/hoon.hoon index 1e3cba2c8e..7c00fbcec4 100644 --- a/arvo/hoon.hoon +++ b/arvo/hoon.hoon @@ -3409,7 +3409,7 @@ cab (cold ' ' dot) (cook tuft (ifix [sig dot] hex)) - (cold '~' ;~(plug sig sig)) + ;~(pfix sig ;~(pose sig dot)) == ++ voy ;~(pfix bas ;~(pose bas soq bix)) -- From f85d0cd09bf0c25c2ced823c0f0193fd76c860bd Mon Sep 17 00:00:00 2001 From: Max G Date: Wed, 29 Jul 2015 06:56:02 +0300 Subject: [PATCH 08/20] ++rd jets --- arvo/hoon.hoon | 722 ++++++++----------------------------------------- 1 file changed, 112 insertions(+), 610 deletions(-) diff --git a/arvo/hoon.hoon b/arvo/hoon.hoon index 55040cc85d..974f2c222f 100644 --- a/arvo/hoon.hoon +++ b/arvo/hoon.hoon @@ -1299,6 +1299,10 @@ |= [a=fn] ^- fn ?-(-.a %f a(s !s.a), %i a(s !s.a), %n a) :: + ++ syn + |= [a=fn] ^- ? + ?-(-.a %f s.a, %i s.a, %n &) + :: ++ abs |= [a=fn] ^- fn ?: ?=([%f *] a) [%f & e.a a.a] @@ -1388,13 +1392,6 @@ ?~ a.a [%f s.a zer:m] ?: s.a (sqt:m +>.a) [%n ~] :: - ++ isr :: inverse square root - |= [a=fn] ^- fn - ?: ?=([%n *] a) [%n ~] - ?: ?=([%i *] a) [%n ~] - ?~ a.a [%n ~] - ?: s.a (isr:m +>.a) [%n ~] - :: ++ inv |= [a=fn] ^- fn (div [%f & --0 1] a) @@ -1457,354 +1454,12 @@ |= [a=dn] ^- fn ?: ?=([%n *] a) [%n ~] ?: ?=([%i *] a) [%i s.a] + => .(r %n) :: always rnd nearest =+ q=(abs:si e.a) ?: (syn:si e.a) (mul [%f s.a --0 a.a] [%f & e.a (pow:m 5 q)]) (div [%f s.a --0 a.a] [%f & (sun:si q) (pow:m 5 q)]) :: - ++ c :: mathematical constants - |% - ++ pi - ~+ |- ^- fn - ?: (^lth prc:m 1.200) - =+ ^= ap 0wOg~qE.y5EMz.j4NCa.bwdMs.QiA2j.wyapY.NQ0wK.-FzIj. - CO9hi.wxVzz.g4Tu-.l6rfd.eAcrc.2Iarv.9v53t.fUjlJ. - rl72h.ui5Jn.pynDX.6Z4N2.WqoTX.mIb~R.OSZ0q.TXuUU. - q~Jqy.p-BHF.YA4nN.b7-p9.a6phX.ehrfs.80vby.xoXY5. - CdF8d.xNlQV.FF5z-.E~ijf.nUdBn.ifsEW.Sm76b.Ply25 - (rau:m [-1.198 ap] |) - =- - =+ wp=(^add prc:m 16) - =+ nc=16 - |- - ?: (^gth wp mxp:m) - ~| %very-large-precision !! - =+ [x=(bnd:m (ka wp))] - ?~ x $(wp (^add wp nc), nc (^mul nc 2)) - +.x - :: - ^= ka |= [p=@] ^- [fn fn] - => .(r %n, ^p p, d %i) - =+ [a=`fn`[%f & --0 1] b=`fn`[%f & -1 1]] - =+ [d=`fn`[%f & -2 1] la=a k=0] - |- - =+ s=(shf:m (add a b) -2) - =+ lb=(sqt b) - =. la (shf:m (add la lb) -1) - =. a (mul la la) - =. b (shf:m (sub a s) --1) - =+ e=(ned:m (ead a (fli b))) - =. d (sub d e(e (sum:si e.e (sun:si k)))) - =+ f=(dif:si (sun:si k) (sun:si p)) - ?: (need (gth (abs e) [%f & f 1])) - $(k +(k)) - =+ ^= g - (dif:si (sun:si (^add (^mul k 2) 8)) (sun:si p)) - [(div b d) [%f & g 1]] - :: - ++ log2 :: natural logarithm of 2 - ~+ |- ^- fn - ?: (^lth prc:m 1.200) - =+ ^= ap 0wIn8nZ.Z7fuq.L9UXe.o0~bS.HQ3Pg.OpOCb.oJywQ.nmUKG. - -yLDK.7owru.KIC5m.lkLJa.-xIgX.iWKds.4U8kg.DlPIF. - 4mCU9.jWmOx.oyiKz.56ILq.4j5Ye.7WVWF.L3Ijp.weOlL. - EeNSl.~tbsI.W7IpR.BicHR.TWqZe.30Oi6.lvEos.L8eey. - SySnN.gY~Rs.o7ZcE.h-RLX.A64dc.fyfVl.6yXBq.trvMu - (rau:m [-1.200 ap] |) - =- - =+ wp=(^add prc:m 16) - =+ nc=16 - |- - ?: (^gth wp mxp:m) - ~| %very-large-precision !! - =+ [x=(bnd:m (ka wp))] - ?~ x $(wp (^add wp nc), nc (^mul nc 2)) - +.x - :: - ^= ka |= [p=@] ^- [fn fn] - => .(r %n, ^p p, d %i) - =+ n=+((^div p 3)) - =+ o=(dec (^mul n 2)) - =+ ^= q %- sun - %+ ^mul 4 - %+ ^mul (bex (dec n)) - %- fac:m [0 o] - =+ ^= t %- sun - %+ ^mul 3 - =+ [c=0 d=0] - |- ?: =(c n) d - =+ ^= e - =+ f=(fac:m 0 c) - %+ ^mul (^mul f f) - %+ ^mul (bex (^sub (dec n) c)) - %+ fac:m +((^mul c 2)) o - $(c +(c), d ?~((end 0 1 c) (^add d e) (^sub d e))) - [(div t q) [%f & (dif:si --2 (sun:si p)) 1]] - -- - :: - ++ e :: elementary functions - |% - ++ cos - |= [a=fn] ^- fn - ?. ?=([%f *] a) [%n ~] - ?: =(a.a 0) (rou [%f & --0 1]) - =- - =+ wp=(^add prc:m 16) - =+ nc=16 - |- - ?: (^gth wp mxp:m) - ~| %very-large-precision !! - =+ [x=(bnd:m (ka wp))] - ?~ x $(wp (^add wp nc), nc (^mul nc 2)) - +.x - :: - ^= ka |= [p=@] ^- [fn fn] - =+ n=prc:m - => .(r %n, ^p p, d %i) - =. a - =+ q=(ibl:m +>.a) - ?: =((cmp:si q --1) -1) a - =+ ^= pi - => .(^p (^add ^p (abs:si q))) - (shf:m pi:c --1) - (ned:m (rem:m a pi)) - =+ k=-:(itr:m (^div n 2)) - =+ ^= i %+ shf:m =>(.(r %u) (mul a a)) - (new:si | (^mul k 2)) - =+ [s=`fn`[%f & --0 1] t=`fn`[%f & --0 1] l=1] - |- - ?> ?=([%f *] t) - ?. ?| - =(a.t 0) - =+ q=(dif:si (ibl:m +>.t) --1) - =((cmp:si q (new:si | p)) -1) - == - =. t (ned:m =>(.(r %u) (mul t i))) - =+ ^= q - =+ j=(^mul l 2) - (^mul j (dec j)) - =. t (ned:m =>(.(r %u) (div t [%f & --0 q]))) - =+ u=?~((dis 1 l) t (fli t)) - =. s (ned:m =>(.(r %d) (add s u))) - $(l +(l)) - =+ w=k - |- ?~ k :- s - =+ q=(dif:si (sun:si (^mul w 2)) (sun:si p)) - [%f & q +((^mul l 2))] - =. s - =+ q=(ned:m =>(.(r %u) (mul s s))) - (sub q(e (sum:si e.q --1)) [%f & --0 1]) - $(k (dec k)) - :: - ++ sin - |= [a=fn] ^- fn - ?. ?=([%f *] a) [%n ~] - ?: =(a.a 0) [%f & zer:m] - =- - =+ wp=(^add prc:m 16) - =+ nc=16 - |- - ?: (^gth wp mxp:m) - ~| %very-large-precision !! - =+ [x=(bnd:m (ka wp))] - ?~ x $(wp (^add wp nc), nc (^mul nc 2)) - +.x - :: - ^= ka |= [p=@] ^- [fn fn] - => .(r %n, ^p p, d %i) - =. a - =+ q=(ibl:m +>.a) - ?: =((cmp:si q --1) -1) a - =+ ^= pi - => .(^p (^add ^p (abs:si q))) - (shf:m pi:c --1) - (ned:m (rem:m a pi)) - =+ c==>(.(r %a) (cos a)) - =+ t==>(.(r %a) (mul c c)) - =+ u==>(.(r %z) (sub [%f & --0 1] t)) - =+ s=(ned:m =>(.(r %z) (sqt u))) - :- s(s +<.a) - =+ e=(sum:si (sun:si (^mul p 2)) e.s) - [%f & (dif:si --3 e) 1] - :: - ++ tan - |= [a=fn] ^- fn - ?. ?=([%f *] a) [%n ~] - =- - =+ wp=(^add prc:m 8) - =+ nc=8 - |- - ?: (^gth wp mxp:m) - ~| %very-large-precision !! - =+ [x=(bnd:m (ka wp))] - ?~ x $(wp (^add wp nc), nc (^mul nc 2)) - +.x - :: - ^= ka |= [p=@] ^- [fn fn] - => .(r %n, ^p p, d %i) - =+ [s=(sin a) c=(cos a)] - =+ t=(div s c) - ?. ?=([%f *] t) [t [%f & zer:m]] - [t [%f & e.t 4]] - :: - ++ acos - |= [a=fn] ^- fn - !! - :: - ++ asin - |= [a=fn] ^- fn - !! - :: - ++ atan - |= [a=fn] ^- fn - !! - :: - ++ cosh - |= [a=fn] ^- fn - !! - :: - ++ sinh - |= [a=fn] ^- fn - !! - :: - ++ tanh - |= [a=fn] ^- fn - !! - :: - ++ acosh - |= [a=fn] ^- fn - !! - :: - ++ asinh - |= [a=fn] ^- fn - !! - :: - ++ atanh - |= [a=fn] ^- fn - !! - :: - ++ exp - |= [a=fn] ^- fn - ?: ?=([%n *] a) [%n ~] - ?: ?=([%i *] a) ?:(s.a [%i &] [%f & zer:m]) - ?~ a.a (rou [%f & --0 1]) - =- - =+ wp=(^add prc:m 16) - =+ nc=16 - |- - ?: (^gth wp mxp:m) - ~| %very-large-precision !! - =+ [x=(bnd:m (ka wp))] - ?~ x $(wp (^add wp nc), nc (^mul nc 2)) - +.x - :: - ^= ka |= [p=@] ^- [fn fn] - => .(r %n, ^p p, d %i) - !! - :: - ++ log - |= [a=fn] ^- fn - ?: ?=([%n *] a) [%n ~] - ?: ?=([%i *] a) ?:(s.a [%i &] [%n ~]) - ?~ a.a [%i |] ?. s.a [%n ~] - ?: (need (equ a [%f & --0 1])) [%f & zer:m] - =- - =+ wp=(^add prc:m 16) - =+ nc=16 - |- - ?: (^gth wp mxp:m) - ~| %very-large-precision !! - =+ [x=(bnd:m (ka wp))] - ?~ x $(wp (^add wp nc), nc (^mul nc 2)) - +.x - :: - ^= ka |= [p=@] ^- [fn fn] - => .(r %n, ^p p, d %i) - =+ ^= n - =+ q=(sun:si (^div +(^p) 2)) - (sum:si (dif:si q (ibl:m +>.a)) --2) - =. a (ned:m (shf:m a n)) - =. a (ned:m (agm [%f & --0 1] (div [%f & --0 4] a))) - =. a (ned:m (shf:m a --1)) - =. a (ned:m (div pi:c a)) - =+ j=(old:si n) - =+ q=(mul [%f -.j --0 +.j] log2:c) - =+ b=(ned:m (sub a q)) - =+ e=(dif:si (ibl:m +>.a) (ibl:m +>.b)) - :- b [%f & (sum:si e.b e) 11] - :: - ++ log2 - |= [a=fn] ^- fn - ?: ?=([%n *] a) [%n ~] - ?: ?=([%i *] a) ?:(s.a [%i &] [%n ~]) - ?~ a.a [%i |] ?. s.a [%n ~] - =+ q=(ibl:m +>.a) - ?: (need (equ a [%f & q 1])) - (rou [%f (syn:si q) --0 (abs:si q)]) - =- - =+ wp=(^add prc:m 8) - =+ nc=8 - |- - ?: (^gth wp mxp:m) - ~| %very-large-precision !! - =+ [x=(bnd:m (ka wp))] - ?~ x $(wp (^add wp nc), nc (^mul nc 2)) - +.x - :: - ^= ka |= [p=@] ^- [fn fn] - => .(r %n, ^p p, d %i) - =+ q==>(.(r %d) log2:c) - =+ z=(ned:m (div (log a) q)) - :- z [%f & e.z 5] - :: - ++ log10 - |= [a=fn] ^- fn - !! - :: - ++ pow - |= [a=fn b=fn] ^- fn - !! - :: - ++ agm :: arithmetic-geometric mean - |= [a=fn b=fn] ^- fn - ?: |(?=([%n *] a) ?=([%n *] b)) [%n ~] - ?: &(?=([%i *] a) ?=([%i *] b)) - ?: &(=(s.a s.b) s.a) a [%n ~] - ?: ?=([%i *] a) ?> ?=([%f *] b) - ?: |(=(a.b 0) !s.a) [%n ~] [%i &] - ?: ?=([%i *] b) ?> ?=([%f *] a) - ?: |(=(a.a 0) !s.b) [%n ~] [%i &] - ?: |(=(a.a 0) =(a.b 0)) [%f & zer:m] - ?. &(s.a s.b) [%n ~] - =- - =+ wp=(^add prc:m 16) - =+ nc=16 - |- - ?: (^gth wp mxp:m) - ~| %very-large-precision !! - =+ [x=(bnd:m (ka wp))] - ?~ x $(wp (^add wp nc), nc (^mul nc 2)) - +.x - :: - ^= ka |= [p=@] ^- [fn fn] - => .(r %n, ^p p, d %i) - =+ s=(ned:m (mul a b)) - =+ u=(ned:m (sqt s)) - =+ ^= v - =+ q=(ned:m (add a b)) - q(e (dif:si e.q --1)) - =+ n=1 |- - =+ j=(ned:m (ead v (fli u))) - =+ ^= y |. %+ cmp:si %- need (cmp2:m v j) - (sun:si (^sub p 2)) - ?: |(=(a.j 0) =((y) --1)) - [v [%f & e.v (^add (^mul n 18) 51)]] :: XX error bounds correct? - =+ ^= nv - =+ q=(ned:m (add u v)) - q(e (dif:si e.q --1)) - $(v nv, u (ned:m (sqt (mul u v))), n +(n)) - -- - :: ++ m :: internal functions, constants |% :: don't put 0s into [@s @u] args ++ rou @@ -1830,9 +1485,9 @@ =+ ^= x %+ sum:si e.b (sun:si mb) :: highest exponent that b reaches ?: =((cmp:si w x) --1) :: don't actually need to add ?- r - %z (lag %fl a) %d (lag %fl a) - %a (lag %lg a) %u (lag %lg a) - %n (lag %na a) + %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)]) :: @@ -1847,9 +1502,9 @@ =+ ^= x %+ sum:si e.b (sun:si mb) ?: &(!e =((cmp:si w x) --1)) ?- r - %z (lag %sm a) %d (lag %sm a) - %a (lag %ce a) %u (lag %ce a) - %n (lag %nt a) + %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) @@ -1869,21 +1524,13 @@ =. 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=(^^div a.a a.b)] - ?+ r (rou [j q]) - %u ?~ (mod a.a a.b) (lag %ce [j q]) (lag %lg [j q]) - %a ?~ (mod a.a a.b) (lag %ce [j q]) (lag %lg [j q]) - %n ?~ (mod a.a a.b) (lag %ne [j q]) (lag %na [j q]) - == + =+ k=(mod a.a a.b) + (rau [j q] =(k 0)) :: ++ fma |= [a=[e=@s a=@u] b=[e=@s a=@u] c=[e=@s a=@u]] ^- fn (add [(sum:si e.a e.b) (^^mul a.a a.b)] c |) :: - ++ fms - |= [a=[e=@s a=@u] b=[e=@s a=@u] c=[e=@s a=@u] d=?] ^- fn - ?: d (sub [(sum:si e.a e.b) (^^mul a.a a.b)] c |) - (sub c [(sum:si e.a e.b) (^^mul a.a a.b)] |) - :: :: integer square root w/sticky bit ++ itr |= [a=@] ^- [@ ?] @@ -1896,19 +1543,6 @@ ?: (^^lte - a) $(r s, q (dec q)) $(q (dec q)) [-.c =(+.c a)] :: - :: integer inverse square root w/shift amount & sticky bit - ++ iir - |= [a=@] ^- [@ @ ?] - =+ [sa=(dec (xeb a))] - =+ [q=(^^div (xeb a) 2) z=(bex (^^mul sa 2)) r=0] - =+ ^= c - |- =+ s=(^^add r (bex q)) - =+ (^^mul a (^^mul s s)) - ?: =(q 0) - ?: (^^lte - z) [s -] [r (^^mul a (^^mul r r))] - ?: (^^lte - z) $(r s, q (dec q)) $(q (dec q)) - [-.c sa =(+.c z)] - :: ++ frd :: a/2, rounds to -inf |= [a=@s] =+ b=(old:si a) @@ -1927,18 +1561,6 @@ =+ [y=(itr a.a) z=(frd e.a)] (rau [z -.y] +.y) :: - ++ isr - |= [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=(iir a.a) z=(frd e.a)] - =+ q=(new:si !(syn:si z) (abs:si z)) - (rau [(dif:si q (sun:si +<.y)) -.y] +>.y) - :: ++ lth |= [a=[e=@s a=@u] b=[e=@s a=@u]] ^- ? ?: =(e.a e.b) (^^lth a.a a.b) @@ -1996,18 +1618,7 @@ (min q (^^sub prc (met 0 a.a))) a(e (dif:si e.a (sun:si -)), a (lsh 0 - a.a)) :: - :: required precision if sticky bit - ++ rpr - |= [a=@s] - ?: |(=(den %i) =((cmp:si emn a) -1)) +(prc) - =+ b=(abs:si (dif:si emn a)) - ?: (^^lte b prc) (^^add (^^sub prc b) 2) 1 - :: :: in order: floor, ceiling, nearest (even, away from 0, toward 0), larger, smaller - ++ lag - |= [t=?(%fl %ce %ne %na %nt %lg %sm) a=[e=@s a=@u]] ^- fn - (lug t a &) - :: :: t=sticky bit ++ lug |= [t=?(%fl %ce %ne %na %nt %lg %sm) a=[e=@s a=@u] s=?] ^- fn @@ -2018,7 +1629,6 @@ ?: =((met 0 ->+>) prc) - [%f & zer] :: =+ m=(met 0 a.a) - ?> |(s (^gte m (rpr e.a))) :: sticky bit requires precision =+ ^= q =+ ^= f :: reduce precision ?: (^gth m prc) (^^sub m prc) 0 @@ -2093,7 +1703,6 @@ r (mod (^^mul r 10) s) m (^^mul m 10) == - ?> (^^lth u 10) =+ l=(^^lth (^^mul r 2) m) =+ ^= h ?| (^^lth (^^mul s 2) m) @@ -2115,74 +1724,16 @@ (^^mul d a) d :: - ++ fac :: b! / a! - |= [a=@ b=@] - =+ x=(^^sub b a) - ?: =(x 0) 1 - ?: =(x 1) b - ?: =(x 2) (^^mul b (dec b)) - =+ y=(^^div (^^add a b) 2) - (^^mul $(b y) $(a y)) - :: - ++ bnd - |= [a=fn b=fn] ^- (unit fn) - =+ x=(^add a b) - =+ y=(^sub a b) - ?: =(x y) [~ x] ~ - :: - ++ chb :: l <= a <= h - |= [a=fn l=fn h=fn] ^- ? - &((fall (^lte l a) |) (fall (^lte a h) |)) - :: ++ ned |= [a=fn] ^- [%f s=? e=@s a=@u] ?: ?=([%f *] a) a ~| %need-float !! :: - ++ cmd - |= [a=@u b=@u] ^- @s - =+ c=(^^div a b) - =+ d=(mod a b) - =+ e=(^^mul d 2) - =+ ^= f - ?: (^^lth e b) c - ?. =(e b) +(c) - ?~((end 0 1 c) c +(c)) - (dif:si (sun:si a) (sun:si (^^mul b f))) - :: - ++ rem - |= [a=fn b=fn] :: a cmod b - =. b (abs b) - ?: |(?=([%n *] a) ?=([%n *] b)) [%n ~] - ?: |(?=([%i *] a) ?=([%i *] b)) [%n ~] - ?~ a.a [%f & zer:m] ?~ a.b [%n ~] - |- ?. s.a =.(r swr (fli $(s.a &))) - =+ [ma=(met 0 a.a) mb=(met 0 a.b)] - =+ ^= q - ?. =((cmp:si e.a e.b) -1) --0 - (dif:si e.b e.a) - =+ al=a(a (end 0 (abs:si q) a.a)) - =+ ah=a(a (rsh 0 (abs:si q) a.a), e (sum:si e.a q)) - =+ w=(abs:si (dif:si e.ah e.b)) - =+ z=(mod (bex w) a.b) - =+ x=(old:si (cmd:m (^^mul a.ah z) a.b)) - =+ r=`fn`[%f -.x e.b +.x] - ?: |((need (^lth r b(e (dif:si e.b --1)))) =(a.al 0)) - (^add r al) - (^sub al r) - :: ++ shf |= [a=fn b=@s] ?: |(?=([%n *] a) ?=([%i *] a)) a a(e (sum:si e.a b)) :: - ++ cmp2 :: impl. of cmp2 as in - |= [a=fn b=fn] ^- (unit ,@s) :: mpfr's algorithms manual - ?> &(?=([%f *] a) ?=([%f *] b)) :: XX unoptimized - ?~ a.a !! - =+ c=(ned (ead a (fli b))) - ?~ a.c ~ :- ~ (dif:si (ibl +>.a) (ibl +>.b)) - :: ++ swr ?+(r r %d %u, %u %d) ++ prc ?>((^gth p 1) p) ++ mxp 20.000 :: max precision for some stuff @@ -2190,10 +1741,11 @@ ++ emn v ++ emm (sum:si emn (sun:si (dec prc))) ++ emx (sum:si emn (sun:si w)) - ++ spd [emn 1] :: smallest "denormal" - ++ spn [emn (bex (dec prc))] :: smallest "normal" - ++ lfn [emx (fil 0 prc 1)] :: largest - ++ zer [--0 0] :: zero + ++ spd [e=emn a=1] :: smallest "denormal" + ++ spn [e=emn a=(bex (dec prc))] :: smallest "normal" + ++ lfn [e=emx a=(fil 0 prc 1)] :: largest + ++ lfe (sum:si emx (sun:si prc)) :: 2^lfe is larger than all floats + ++ zer [e=--0 a=0] -- -- :: @@ -2205,8 +1757,7 @@ :: ++ pa =+ i=(dif:si (dif:si --1 b) (sun:si p)) - =+ q=fl - q(p +(p), v i, w (^sub (bex w) 3), d ?:(f %f %d), r r) + %*(. fl p +(p), v i, w (^sub (bex w) 3), d ?:(f %f %d), r r) :: ++ sea |= [a=@r] ^- fn @@ -2255,11 +1806,11 @@ ++ sqt |= [a=@r] (bif (sqt:pa (sea a))) ++ sun |= [a=@u] (bit [%f & --0 a]) ++ san |= [a=@s] (bit [%f (syn:si a) --0 (abs:si a)]) - ++ lth |= [a=@r b=@r] (lth:pa (sea a) (sea b)) - ++ lte |= [a=@r b=@r] (lte:pa (sea a) (sea b)) - ++ equ |= [a=@r b=@r] (equ:pa (sea a) (sea b)) - ++ gte |= [a=@r b=@r] (gte:pa (sea a) (sea b)) - ++ gth |= [a=@r b=@r] (gth:pa (sea a) (sea b)) + ++ lth |= [a=@r b=@r] (fall (lth:pa (sea a) (sea b)) |) + ++ lte |= [a=@r b=@r] (fall (lte:pa (sea a) (sea b)) |) + ++ equ |= [a=@r b=@r] (fall (equ:pa (sea a) (sea b)) |) + ++ gte |= [a=@r b=@r] (fall (gte:pa (sea a) (sea b)) |) + ++ gth |= [a=@r b=@r] (fall (gth:pa (sea a) (sea b)) |) ++ drg |= [a=@r] (drg:pa (sea a)) ++ grd |= [a=dn] (bif (grd:pa a)) -- @@ -2274,179 +1825,130 @@ ++ rylq |= a=dn ^- @rq (grd:rq a) :: ++ rd + ~% %rd + ~ |% ++ ma - =>(ff .(w 11, p 52, b --1.023, f %.n, r %n)) + %*(. ff w 11, p 52, b --1.023, f %.n) ++ sea |= [a=@rd] (sea:ma a) ++ bit |= [a=fn] ^- @rd (bit:ma a) - ++ sig - |= [a=@rd] (sig:ma a) - ++ exp - |= [a=@rd] (exp:ma a) - ++ add + ++ add ~/ %add |= [a=@rd b=@rd] ^- @rd (add:ma a b) - ++ sub + ++ sub ~/ %sub |= [a=@rd b=@rd] ^- @rd (sub:ma a b) - ++ mul + ++ mul ~/ %mul |= [a=@rd b=@rd] ^- @rd (mul:ma a b) - ++ div + ++ div ~/ %div |= [a=@rd b=@rd] ^- @rd (div:ma a b) - ++ fma + ++ fma ~/ %fma |= [a=@rd b=@rd c=@rd] ^- @rd (fma:ma a b c) - ++ sqt + ++ sqt ~/ %sqt |= [a=@rd] ^- @rd (sqt:ma a) - ++ sun - |= [a=@u] ^- @rd (sun:ma a) - ++ san - |= [a=@s] ^- @rd (san:ma a) - ++ lth - |= [a=@rd b=@rd] (lth:ma a b) - ++ lte - |= [a=@rd b=@rd] (lte:ma a b) - ++ equ - |= [a=@rd b=@rd] (equ:ma a b) - ++ gte - |= [a=@rd b=@rd] (gte:ma a b) - ++ gth - |= [a=@rd b=@rd] (gth:ma a b) - ++ drg - |= [a=@rd] (drg:ma a) - ++ grd - |= [a=dn] (grd:ma a) + :: + ++ sun |= [a=@u] ^- @rd (sun:ma a) + ++ san |= [a=@s] ^- @rd (san:ma a) + ++ lth ~/ %lth |= [a=@rd b=@rd] (lth:ma a b) + ++ lte ~/ %lte |= [a=@rd b=@rd] (lte:ma a b) + ++ equ ~/ %equ |= [a=@rd b=@rd] (equ:ma a b) + ++ gte ~/ %gte |= [a=@rd b=@rd] (gte:ma a b) + ++ gth ~/ %gth |= [a=@rd b=@rd] (gth:ma a b) + ++ sig |= [a=@rd] (sig:ma a) + ++ exp |= [a=@rd] (exp:ma a) + ++ drg |= [a=@rd] (drg:ma a) + ++ grd |= [a=dn] (grd:ma a) -- :: ++ rs + ~% %rs + ~ |% ++ ma - =>(ff .(w 8, p 23, b --127, f %.n, r %n)) + %*(. ff w 8, p 23, b --127, f %.n) ++ sea |= [a=@rs] (sea:ma a) ++ bit |= [a=fn] ^- @rs (bit:ma a) - ++ sig - |= [a=@rs] (sig:ma a) - ++ exp - |= [a=@rs] (exp:ma a) - ++ add + ++ add ~/ %add |= [a=@rs b=@rs] ^- @rs (add:ma a b) - ++ sub + ++ sub ~/ %sub |= [a=@rs b=@rs] ^- @rs (sub:ma a b) - ++ mul + ++ mul ~/ %mul |= [a=@rs b=@rs] ^- @rs (mul:ma a b) - ++ div + ++ div ~/ %div |= [a=@rs b=@rs] ^- @rs (div:ma a b) - ++ fma + ++ fma ~/ %fma |= [a=@rs b=@rs c=@rs] ^- @rs (fma:ma a b c) - ++ sqt + ++ sqt ~/ %sqt |= [a=@rs] ^- @rs (sqt:ma a) - ++ sun - |= [a=@u] ^- @rs (sun:ma a) - ++ san - |= [a=@s] ^- @rs (san:ma a) - ++ lth - |= [a=@rs b=@rs] (lth:ma a b) - ++ lte - |= [a=@rs b=@rs] (lte:ma a b) - ++ equ - |= [a=@rs b=@rs] (equ:ma a b) - ++ gte - |= [a=@rs b=@rs] (gte:ma a b) - ++ gth - |= [a=@rs b=@rs] (gth:ma a b) - ++ drg - |= [a=@rs] (drg:ma a) - ++ grd - |= [a=dn] (grd:ma a) + :: + ++ sun |= [a=@u] ^- @rs (sun:ma a) + ++ san |= [a=@s] ^- @rs (san:ma a) + ++ lth ~/ %lth |= [a=@rs b=@rs] (lth:ma a b) + ++ lte ~/ %lte |= [a=@rs b=@rs] (lte:ma a b) + ++ equ ~/ %equ |= [a=@rs b=@rs] (equ:ma a b) + ++ gte ~/ %gte |= [a=@rs b=@rs] (gte:ma a b) + ++ gth ~/ %gth |= [a=@rs b=@rs] (gth:ma a b) + ++ sig |= [a=@rs] (sig:ma a) + ++ exp |= [a=@rs] (exp:ma a) + ++ drg |= [a=@rs] (drg:ma a) + ++ grd |= [a=dn] (grd:ma a) + -- +:: +++ rq + ~% %rq + ~ + |% + ++ ma + %*(. ff w 15, p 112, b --16.383, f %.n) + ++ sea + |= [a=@rq] (sea:ma a) + ++ bit + |= [a=fn] ^- @rq (bit:ma a) + ++ add ~/ %add + |= [a=@rq b=@rq] ^- @rq (add:ma a b) + ++ sub ~/ %sub + |= [a=@rq b=@rq] ^- @rq (sub:ma a b) + ++ mul ~/ %mul + |= [a=@rq b=@rq] ^- @rq (mul:ma a b) + ++ div ~/ %div + |= [a=@rq b=@rq] ^- @rq (div:ma a b) + ++ fma ~/ %fma + |= [a=@rq b=@rq c=@rq] ^- @rq (fma:ma a b c) + ++ sqt ~/ %sqt + |= [a=@rq] ^- @rq (sqt:ma a) + :: + ++ sun |= [a=@u] ^- @rq (sun:ma a) + ++ san |= [a=@s] ^- @rq (san:ma a) + ++ lth ~/ %lth |= [a=@rq b=@rq] (lth:ma a b) + ++ lte ~/ %lte |= [a=@rq b=@rq] (lte:ma a b) + ++ equ ~/ %equ |= [a=@rq b=@rq] (equ:ma a b) + ++ gte ~/ %gte |= [a=@rq b=@rq] (gte:ma a b) + ++ gth ~/ %gth |= [a=@rq b=@rq] (gth:ma a b) + ++ sig |= [a=@rq] (sig:ma a) + ++ exp |= [a=@rq] (exp:ma a) + ++ drg |= [a=@rq] (drg:ma a) + ++ grd |= [a=dn] (grd:ma a) -- :: ++ rh |% ++ ma - =>(ff .(w 5, p 10, b --15, f %.n, r %n)) + %*(. ff w 5, p 10, b --15, f %.n) ++ sea |= [a=@rh] (sea:ma a) ++ bit |= [a=fn] ^- @rh (bit:ma a) - ++ sig - |= [a=@rh] (sig:ma a) - ++ exp - |= [a=@rh] (exp:ma a) - ++ add - |= [a=@rh b=@rh] ^- @rh (add:ma a b) - ++ sub - |= [a=@rh b=@rh] ^- @rh (sub:ma a b) - ++ mul - |= [a=@rh b=@rh] ^- @rh (mul:ma a b) - ++ div - |= [a=@rh b=@rh] ^- @rh (div:ma a b) - ++ fma - |= [a=@rh b=@rh c=@rh] ^- @rh (fma:ma a b c) - ++ sqt - |= [a=@rh] ^- @rh (sqt:ma a) - ++ sun - |= [a=@u] ^- @rh (sun:ma a) - ++ san - |= [a=@s] ^- @rh (san:ma a) - ++ lth - |= [a=@rh b=@rh] (lth:ma a b) - ++ lte - |= [a=@rh b=@rh] (lte:ma a b) - ++ equ - |= [a=@rh b=@rh] (equ:ma a b) - ++ gte - |= [a=@rh b=@rh] (gte:ma a b) - ++ gth - |= [a=@rh b=@rh] (gth:ma a b) - ++ drg - |= [a=@rh] (drg:ma a) - ++ grd - |= [a=dn] (grd:ma a) - -- -:: -++ rq - |% - ++ ma - =>(ff .(w 15, p 112, b --16.383, f %.n, r %n)) - ++ sea - |= [a=@rq] (sea:ma a) - ++ bit - |= [a=fn] ^- @rq (bit:ma a) - ++ sig - |= [a=@rq] (sig:ma a) - ++ exp - |= [a=@rq] (exp:ma a) - ++ add - |= [a=@rq b=@rq] ^- @rq (add:ma a b) - ++ sub - |= [a=@rq b=@rq] ^- @rq (sub:ma a b) - ++ mul - |= [a=@rq b=@rq] ^- @rq (mul:ma a b) - ++ div - |= [a=@rq b=@rq] ^- @rq (div:ma a b) - ++ fma - |= [a=@rq b=@rq c=@rq] ^- @rq (fma:ma a b c) - ++ sqt - |= [a=@rq] ^- @rq (sqt:ma a) - ++ sun - |= [a=@u] ^- @rq (sun:ma a) - ++ san - |= [a=@s] ^- @rq (san:ma a) - ++ lth - |= [a=@rq b=@rq] (lth:ma a b) - ++ lte - |= [a=@rq b=@rq] (lte:ma a b) - ++ equ - |= [a=@rq b=@rq] (equ:ma a b) - ++ gte - |= [a=@rq b=@rq] (gte:ma a b) - ++ gth - |= [a=@rq b=@rq] (gth:ma a b) - ++ drg - |= [a=@rq] (drg:ma a) - ++ grd - |= [a=dn] (grd:ma a) + :: + ++ sun |= [a=@u] ^- @rh (sun:ma a) + ++ san |= [a=@s] ^- @rh (san:ma a) + ++ lth |= [a=@rh b=@rh] (lth:ma a b) + ++ lte |= [a=@rh b=@rh] (lte:ma a b) + ++ equ |= [a=@rh b=@rh] (equ:ma a b) + ++ gte |= [a=@rh b=@rh] (gte:ma a b) + ++ gth |= [a=@rh b=@rh] (gth:ma a b) + ++ sig |= [a=@rh] (sig:ma a) + ++ exp |= [a=@rh] (exp:ma a) + ++ drg |= [a=@rh] (drg:ma a) + ++ grd |= [a=dn] (grd:ma a) -- :::::::::::::::::::::::::::::::::::::::::::::::::::::::::: :: section 2cH, urbit time :: From fa8fd7d888359e2657fe9a20d8e439aa916145d3 Mon Sep 17 00:00:00 2001 From: Max G Date: Wed, 29 Jul 2015 18:59:21 +0300 Subject: [PATCH 09/20] ++rs jets --- arvo/hoon.hoon | 74 +++++++++++++++++++++++++------------------------- 1 file changed, 37 insertions(+), 37 deletions(-) diff --git a/arvo/hoon.hoon b/arvo/hoon.hoon index 974f2c222f..f8e75d8608 100644 --- a/arvo/hoon.hoon +++ b/arvo/hoon.hoon @@ -1834,25 +1834,25 @@ ++ bit |= [a=fn] ^- @rd (bit:ma a) ++ add ~/ %add - |= [a=@rd b=@rd] ^- @rd (add:ma a b) + |= [a=@rd b=@rd] ^- @rd ~| %rd-fail (add:ma a b) ++ sub ~/ %sub - |= [a=@rd b=@rd] ^- @rd (sub:ma a b) + |= [a=@rd b=@rd] ^- @rd ~| %rd-fail (sub:ma a b) ++ mul ~/ %mul - |= [a=@rd b=@rd] ^- @rd (mul:ma a b) + |= [a=@rd b=@rd] ^- @rd ~| %rd-fail (mul:ma a b) ++ div ~/ %div - |= [a=@rd b=@rd] ^- @rd (div:ma a b) + |= [a=@rd b=@rd] ^- @rd ~| %rd-fail (div:ma a b) ++ fma ~/ %fma - |= [a=@rd b=@rd c=@rd] ^- @rd (fma:ma a b c) + |= [a=@rd b=@rd c=@rd] ^- @rd ~| %rd-fail (fma:ma a b c) ++ sqt ~/ %sqt - |= [a=@rd] ^- @rd (sqt:ma a) + |= [a=@rd] ^- @rd ~| %rd-fail (sqt:ma a) :: ++ sun |= [a=@u] ^- @rd (sun:ma a) ++ san |= [a=@s] ^- @rd (san:ma a) - ++ lth ~/ %lth |= [a=@rd b=@rd] (lth:ma a b) - ++ lte ~/ %lte |= [a=@rd b=@rd] (lte:ma a b) - ++ equ ~/ %equ |= [a=@rd b=@rd] (equ:ma a b) - ++ gte ~/ %gte |= [a=@rd b=@rd] (gte:ma a b) - ++ gth ~/ %gth |= [a=@rd b=@rd] (gth:ma a b) + ++ lth ~/ %lth |= [a=@rd b=@rd] ~| %rd-fail (lth:ma a b) + ++ lte ~/ %lte |= [a=@rd b=@rd] ~| %rd-fail (lte:ma a b) + ++ equ ~/ %equ |= [a=@rd b=@rd] ~| %rd-fail (equ:ma a b) + ++ gte ~/ %gte |= [a=@rd b=@rd] ~| %rd-fail (gte:ma a b) + ++ gth ~/ %gth |= [a=@rd b=@rd] ~| %rd-fail (gth:ma a b) ++ sig |= [a=@rd] (sig:ma a) ++ exp |= [a=@rd] (exp:ma a) ++ drg |= [a=@rd] (drg:ma a) @@ -1869,25 +1869,25 @@ ++ bit |= [a=fn] ^- @rs (bit:ma a) ++ add ~/ %add - |= [a=@rs b=@rs] ^- @rs (add:ma a b) + |= [a=@rs b=@rs] ^- @rs ~| %rs-fail (add:ma a b) ++ sub ~/ %sub - |= [a=@rs b=@rs] ^- @rs (sub:ma a b) + |= [a=@rs b=@rs] ^- @rs ~| %rs-fail (sub:ma a b) ++ mul ~/ %mul - |= [a=@rs b=@rs] ^- @rs (mul:ma a b) + |= [a=@rs b=@rs] ^- @rs ~| %rs-fail (mul:ma a b) ++ div ~/ %div - |= [a=@rs b=@rs] ^- @rs (div:ma a b) + |= [a=@rs b=@rs] ^- @rs ~| %rs-fail (div:ma a b) ++ fma ~/ %fma - |= [a=@rs b=@rs c=@rs] ^- @rs (fma:ma a b c) + |= [a=@rs b=@rs c=@rs] ^- @rs ~| %rs-fail (fma:ma a b c) ++ sqt ~/ %sqt |= [a=@rs] ^- @rs (sqt:ma a) :: ++ sun |= [a=@u] ^- @rs (sun:ma a) ++ san |= [a=@s] ^- @rs (san:ma a) - ++ lth ~/ %lth |= [a=@rs b=@rs] (lth:ma a b) - ++ lte ~/ %lte |= [a=@rs b=@rs] (lte:ma a b) - ++ equ ~/ %equ |= [a=@rs b=@rs] (equ:ma a b) - ++ gte ~/ %gte |= [a=@rs b=@rs] (gte:ma a b) - ++ gth ~/ %gth |= [a=@rs b=@rs] (gth:ma a b) + ++ lth ~/ %lth |= [a=@rs b=@rs] ~| %rs-fail (lth:ma a b) + ++ lte ~/ %lte |= [a=@rs b=@rs] ~| %rs-fail (lte:ma a b) + ++ equ ~/ %equ |= [a=@rs b=@rs] ~| %rs-fail (equ:ma a b) + ++ gte ~/ %gte |= [a=@rs b=@rs] ~| %rs-fail (gte:ma a b) + ++ gth ~/ %gth |= [a=@rs b=@rs] ~| %rs-fail (gth:ma a b) ++ sig |= [a=@rs] (sig:ma a) ++ exp |= [a=@rs] (exp:ma a) ++ drg |= [a=@rs] (drg:ma a) @@ -1904,25 +1904,25 @@ ++ bit |= [a=fn] ^- @rq (bit:ma a) ++ add ~/ %add - |= [a=@rq b=@rq] ^- @rq (add:ma a b) + |= [a=@rq b=@rq] ^- @rq ~| %rq-fail (add:ma a b) ++ sub ~/ %sub - |= [a=@rq b=@rq] ^- @rq (sub:ma a b) + |= [a=@rq b=@rq] ^- @rq ~| %rq-fail (sub:ma a b) ++ mul ~/ %mul - |= [a=@rq b=@rq] ^- @rq (mul:ma a b) + |= [a=@rq b=@rq] ^- @rq ~| %rq-fail (mul:ma a b) ++ div ~/ %div - |= [a=@rq b=@rq] ^- @rq (div:ma a b) + |= [a=@rq b=@rq] ^- @rq ~| %rq-fail (div:ma a b) ++ fma ~/ %fma - |= [a=@rq b=@rq c=@rq] ^- @rq (fma:ma a b c) + |= [a=@rq b=@rq c=@rq] ^- @rq ~| %rq-fail (fma:ma a b c) ++ sqt ~/ %sqt - |= [a=@rq] ^- @rq (sqt:ma a) + |= [a=@rq] ^- @rq ~| %rq-fail (sqt:ma a) :: ++ sun |= [a=@u] ^- @rq (sun:ma a) ++ san |= [a=@s] ^- @rq (san:ma a) - ++ lth ~/ %lth |= [a=@rq b=@rq] (lth:ma a b) - ++ lte ~/ %lte |= [a=@rq b=@rq] (lte:ma a b) - ++ equ ~/ %equ |= [a=@rq b=@rq] (equ:ma a b) - ++ gte ~/ %gte |= [a=@rq b=@rq] (gte:ma a b) - ++ gth ~/ %gth |= [a=@rq b=@rq] (gth:ma a b) + ++ lth ~/ %lth |= [a=@rq b=@rq] ~| %rq-fail (lth:ma a b) + ++ lte ~/ %lte |= [a=@rq b=@rq] ~| %rq-fail (lte:ma a b) + ++ equ ~/ %equ |= [a=@rq b=@rq] ~| %rq-fail (equ:ma a b) + ++ gte ~/ %gte |= [a=@rq b=@rq] ~| %rq-fail (gte:ma a b) + ++ gth ~/ %gth |= [a=@rq b=@rq] ~| %rq-fail (gth:ma a b) ++ sig |= [a=@rq] (sig:ma a) ++ exp |= [a=@rq] (exp:ma a) ++ drg |= [a=@rq] (drg:ma a) @@ -1940,11 +1940,11 @@ :: ++ sun |= [a=@u] ^- @rh (sun:ma a) ++ san |= [a=@s] ^- @rh (san:ma a) - ++ lth |= [a=@rh b=@rh] (lth:ma a b) - ++ lte |= [a=@rh b=@rh] (lte:ma a b) - ++ equ |= [a=@rh b=@rh] (equ:ma a b) - ++ gte |= [a=@rh b=@rh] (gte:ma a b) - ++ gth |= [a=@rh b=@rh] (gth:ma a b) + ++ lth |= [a=@rh b=@rh] ~| %rh-fail (lth:ma a b) + ++ lte |= [a=@rh b=@rh] ~| %rh-fail (lte:ma a b) + ++ equ |= [a=@rh b=@rh] ~| %rh-fail (equ:ma a b) + ++ gte |= [a=@rh b=@rh] ~| %rh-fail (gte:ma a b) + ++ gth |= [a=@rh b=@rh] ~| %rh-fail (gth:ma a b) ++ sig |= [a=@rh] (sig:ma a) ++ exp |= [a=@rh] (exp:ma a) ++ drg |= [a=@rh] (drg:ma a) From e78534fb58f1033b169533fe4eae7ca98c37ebeb Mon Sep 17 00:00:00 2001 From: Max G Date: Wed, 29 Jul 2015 23:43:55 +0300 Subject: [PATCH 10/20] a bunch of stuff --- arvo/hoon.hoon | 80 +++++++++++++++++++++++++++++--------------------- 1 file changed, 46 insertions(+), 34 deletions(-) diff --git a/arvo/hoon.hoon b/arvo/hoon.hoon index f8e75d8608..cd5e6425bc 100644 --- a/arvo/hoon.hoon +++ b/arvo/hoon.hoon @@ -1457,8 +1457,8 @@ => .(r %n) :: always rnd nearest =+ q=(abs:si e.a) ?: (syn:si e.a) - (mul [%f s.a --0 a.a] [%f & e.a (pow:m 5 q)]) - (div [%f s.a --0 a.a] [%f & (sun:si q) (pow:m 5 q)]) + (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)]) :: ++ m :: internal functions, constants |% :: don't put 0s into [@s @u] args @@ -1523,26 +1523,13 @@ =+ 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=(^^div a.a a.b)] - =+ k=(mod a.a a.b) - (rau [j q] =(k 0)) + =+ [j=(dif:si e.a e.b) q=(dvr a.a a.b)] + (rau [j p.q] =(q.q 0)) :: ++ fma |= [a=[e=@s a=@u] b=[e=@s a=@u] c=[e=@s a=@u]] ^- fn (add [(sum:si e.a e.b) (^^mul a.a a.b)] c |) :: - :: integer square root w/sticky bit - ++ itr - |= [a=@] ^- [@ ?] - =+ [q=(^^div (dec (xeb a)) 2) r=0] - =+ ^= c - |- =+ s=(^^add r (bex q)) - =+ (^^mul s s) - ?: =(q 0) - ?: (^^lte - a) [s -] [r (^^mul r r)] - ?: (^^lte - a) $(r s, q (dec q)) $(q (dec q)) - [-.c =(+.c a)] - :: ++ frd :: a/2, rounds to -inf |= [a=@s] =+ b=(old:si a) @@ -1558,8 +1545,8 @@ =+ ?: =((dis - 1) (dis (abs:si e.a) 1)) - (^^add - 1) :: enforce even exponent a(e (dif:si e.a (sun:si -)), a (lsh 0 - a.a)) - =+ [y=(itr a.a) z=(frd e.a)] - (rau [z -.y] +.y) + =+ [y=(^^sqt a.a) z=(frd e.a)] + (rau [z p.y] =(q.y 0)) :: ++ lth |= [a=[e=@s a=@u] b=[e=@s a=@u]] ^- ? @@ -1697,10 +1684,12 @@ |- ?: (^gte (^^add (^^mul r 2) m) (^^mul s 2)) $(s (^^mul s 10), k (sum:si k --1)) =+ [u=0 o=0] - |- => %= . + |- + =+ v=(dvr (^^mul r 10) s) + => %= . k (dif:si k --1) - u (^^div (^^mul r 10) s) - r (mod (^^mul r 10) s) + u p.v + r q.v m (^^mul m 10) == =+ l=(^^lth (^^mul r 2) m) @@ -1714,16 +1703,6 @@ =. o (^^add (^^mul o 10) ?:(q +(u) u)) [k o] :: - ++ pow :: a^b - |= [a=@ b=@] - ?: =(b 0) 1 - |- ?: =(b 1) a - =+ c=$(b (^^div b 2)) - =+ d=(^^mul c c) - ?: =((end 0 1 b) 1) - (^^mul d a) - d - :: ++ ned |= [a=fn] ^- [%f s=? e=@s a=@u] ?: ?=([%f *] a) a @@ -1736,7 +1715,6 @@ :: ++ swr ?+(r r %d %u, %u %d) ++ prc ?>((^gth p 1) p) - ++ mxp 20.000 :: max precision for some stuff ++ den d ++ emn v ++ emm (sum:si emn (sun:si (dec prc))) @@ -1937,6 +1915,10 @@ |= [a=@rh] (sea:ma a) ++ bit |= [a=fn] ^- @rh (bit:ma a) + ++ tos + |= [a=@rh] (bit:rs (sea a)) + ++ fos + |= [a=@rs] (bit (sea:rs a)) :: ++ sun |= [a=@u] ^- @rh (sun:ma a) ++ san |= [a=@s] ^- @rh (san:ma a) @@ -2125,6 +2107,36 @@ => .(a `tang`a) ?~ a (+<+) ~_(i.a $(a t.a)) +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +:: section 2cJ, extra math :: +:: +++ sqt :: square root w/remainder + ~/ %sqt + |= a=@ ^- [p=@ q=@] + ?~ a [0 0] + =+ [q=(div (dec (xeb a)) 2) r=0] + =- [-.b (sub a +.b)] + ^= b |- + =+ s=(add r (bex q)) + =+ t=(mul s s) + ?: =(q 0) + ?: (lte t a) [s t] [r (mul r r)] + ?: (lte t a) $(r s, q (dec q)) $(q (dec q)) +:: +++ dvr + ~/ %dvr + |= [a=@ b=@] ^- [p=@ q=@] + ?< =(0 b) + [(div a b) (mod a b)] +:: +++ pow + ~/ %pow + |= [a=@ b=@] + ?: =(b 0) 1 + |- ?: =(b 1) a + =+ c=$(b (div b 2)) + =+ d=(mul c c) + ?~ (dis b 1) d (mul d a) :::::::::::::::::::::::::::::::::::::::::::::::::::::: :: :::: chapter 2d, containers :::: :: :::::::::::::::::::::::::::::::::::::::::::::::::::::: @@ -4793,7 +4805,7 @@ =+ si =+ [c=(sun a) d=(sun b)] =+ [u=[c=(sun 1) d=--0] v=[c=--0 d=(sun 1)]] - |- ^- [d=@ u=@ v=@] + |- ^- [d=@ u=@s v=@s] ?: =(--0 c) [(abs d) d.u d.v] :: ?> ?& =(c (sum (pro (sun a) c.u) (pro (sun b) c.v))) From 6a4b7b4a46e9f66e5694be73c8ed3ea41ef19f9b Mon Sep 17 00:00:00 2001 From: Max G Date: Thu, 30 Jul 2015 01:10:30 +0300 Subject: [PATCH 11/20] refactor ++fl internals --- arvo/hoon.hoon | 447 ++++++++++++++++++++++++------------------------- 1 file changed, 223 insertions(+), 224 deletions(-) diff --git a/arvo/hoon.hoon b/arvo/hoon.hoon index cd5e6425bc..9cb89bc7cd 100644 --- a/arvo/hoon.hoon +++ b/arvo/hoon.hoon @@ -1,4 +1,4 @@ -:::::: :::::::::::::::::::::::::::::::::::::::::::::::::::::: +!::::: :::::::::::::::::::::::::::::::::::::::::::::::::::::: :::::: :::::: Preface :::::: :::::: :::::::::::::::::::::::::::::::::::::::::::::::::::::: ?> ?=(@ .) :: atom subject @@ -1281,186 +1281,13 @@ ++ fl =+ ^- [[p=@u v=@s w=@u] r=?(%n %u %d %z %a) d=?(%d %f %i)] [[113 -16.494 32.765] %n %d] - |% :: p=precision: number of bits in arithmetic form; must be at least 2 :: v=min exponent: minimum value of e :: w=width: max - min value of e, 0 is fixed point :: r=rounding mode: nearest (ties to even), up, down, to zero, away from zero :: d=behavior: return denormals, flush denormals to zero, :: infinite exponent range - ++ rou - |= [a=fn] ^- fn - ?. ?=([%f *] a) a - ?~ a.a [%f s.a zer:m] - ?: s.a (rou:m +>.a) - =.(r swr:m (fli (rou:m +>.a))) - :: - ++ fli - |= [a=fn] ^- fn - ?-(-.a %f a(s !s.a), %i a(s !s.a), %n a) - :: - ++ syn - |= [a=fn] ^- ? - ?-(-.a %f s.a, %i s.a, %n &) - :: - ++ abs - |= [a=fn] ^- fn - ?: ?=([%f *] a) [%f & e.a a.a] - ?: ?=([%i *] a) [%i &] [%n ~] - :: - ++ 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:m] - %- |= [a=fn] - ?. ?=([%f *] a) a - ?. =(a.a 0) a - [%f !=(r %d) zer:m] - ?: =(s.a s.b) - ?: s.a (add:m +>.a +>.b |) - =.(r swr:m (fli (add:m +>.a +>.b |))) - ?: s.a (sub:m +>.a +>.b |) - (sub:m +>.b +>.a |) - :: - ++ ead :: exact 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)) ?~(a.a b a) - [%f ?:(=(r %d) &(s.a s.b) |(s.a s.b)) zer:m] - ?: =(s.a s.b) - ?: s.a (add:m +>.a +>.b &) - (fli (add:m +>.a +>.b &)) - ?: s.a (sub:m +>.a +>.b &) - (sub:m +>.b +>.a &) - :: - ++ sub - |= [a=fn b=fn] ^- fn (add a (fli b)) - :: - ++ 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:m] - ?: =(s.a s.b) (mul:m +>.a +>.b) - =.(r swr:m (fli (mul:m +>.a +>.b))) - :: - ++ emu :: exact multiply - |= [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:m] - [%f =(s.a s.b) (sum:si e.a e.b) (^mul a.a a.b)] - :: - ++ 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:m] - ?: =(a.a 0) ?: =(a.b 0) [%n ~] [%f =(s.a s.b) zer:m] - ?: =(a.b 0) [%i =(s.a s.b)] - ?: =(s.a s.b) (div:m +>.a +>.b) - =.(r swr:m (fli (div:m +>.a +>.b))) - :: - ++ fma :: a * b + c - |= [a=fn b=fn c=fn] ^- fn - (add (emu a b) c) - :: - ++ sqt :: square root - |= [a=fn] ^- fn - ?: ?=([%n *] a) [%n ~] - ?: ?=([%i *] a) ?:(s.a a [%n ~]) - ?~ a.a [%f s.a zer:m] - ?: s.a (sqt:m +>.a) [%n ~] - :: - ++ inv - |= [a=fn] ^- fn - (div [%f & --0 1] a) - :: - ++ sun - |= [a=@u] ^- fn - (rou [%f & --0 a]) - :: - ++ san - |= [a=@s] ^- fn - =+ b=(old:si a) - (rou [%f -.b --0 +.b]) - :: - ++ 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:m +>.a +>.b) (lth:m +>.b +>.a) - :: - ++ lte - |= [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 (lte:m +>.a +>.b) (lte:m +>.b +>.a) - :: - ++ 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:m +>.a +>.b) - :: - ++ gte - |= [a=fn b=fn] ^- (unit ,?) (lte b a) - :: - ++ gth - |= [a=fn b=fn] ^- (unit ,?) (lth b a) - :: - ++ drg :: float to decimal - |= [a=fn] ^- dn - ?: ?=([%n *] a) [%n ~] - ?: ?=([%i *] a) [%i s.a] - ?~ a.a [%d s.a --0 0] - [%d s.a (drg:m +>.a)] - :: - ++ grd :: decimal to float - |= [a=dn] ^- fn - ?: ?=([%n *] a) [%n ~] - ?: ?=([%i *] a) [%i s.a] - => .(r %n) :: always rnd nearest - =+ 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)]) - :: - ++ m :: internal functions, constants + => |% :: don't put 0s into [@s @u] args ++ rou |= [a=[e=@s a=@u]] ^- fn (rau a &) @@ -1478,10 +1305,10 @@ =+ q=(dif:si e.a e.b) |- ?. (syn:si q) $(b a, a b, q +(q)) :: a has larger exponent ?: e - [%f & e.b (^^add (lsh 0 (abs:si q) a.a) a.b)] + [%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 exponent of a - ?: (^gth prc ma) (^^sub prc ma) 0 + ?: (gth prc ma) (^sub prc ma) 0 =+ ^= x %+ sum:si e.b (sun:si mb) :: highest exponent that b reaches ?: =((cmp:si w x) --1) :: don't actually need to add ?- r @@ -1489,7 +1316,7 @@ %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)]) + (rou [e.b (^add (lsh 0 (abs:si q) a.a) a.b)]) :: ++ sub |= [a=[e=@s a=@u] b=[e=@s a=@u] e=?] ^- fn @@ -1498,7 +1325,7 @@ (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 + ?: (gth prc ma) (^sub prc ma) 0 =+ ^= x %+ sum:si e.b (sun:si mb) ?: &(!e =((cmp:si w x) --1)) ?- r @@ -1507,20 +1334,20 @@ %n (lug %nt a &) == =+ j=(lsh 0 (abs:si q) a.a) - |- ?. (^gte j a.b) + |- ?. (gte j a.b) (fli $(a.b j, j a.b, r swr)) - =+ i=(^^sub j a.b) + =+ i=(^sub j a.b) ?~ i [%f & zer] ?: e [%f & e.b i] (rou [e.b i]) :: ++ mul |= [a=[e=@s a=@u] b=[e=@s a=@u]] ^- fn - (rou (sum:si e.a e.b) (^^mul a.a a.b)) + (rou (sum:si e.a e.b) (^mul a.a a.b)) :: ++ 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)))) + =+ 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)] @@ -1528,7 +1355,7 @@ :: ++ fma |= [a=[e=@s a=@u] b=[e=@s a=@u] c=[e=@s a=@u]] ^- fn - (add [(sum:si e.a e.b) (^^mul a.a a.b)] c |) + (add [(sum:si e.a e.b) (^mul a.a a.b)] c |) :: ++ frd :: a/2, rounds to -inf |= [a=@s] @@ -1540,31 +1367,31 @@ ++ sqt |= [a=[e=@s a=@u]] ^- fn =. a - =+ [w=(met 0 a.a) x=(^^mul +(prc) 2)] - =+ ?:((^^lth w x) (^^sub x w) 0) + =+ [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) :: enforce even exponent + (^add - 1) :: enforce even exponent a(e (dif:si e.a (sun:si -)), a (lsh 0 - a.a)) - =+ [y=(^^sqt a.a) z=(frd e.a)] + =+ [y=(^sqt a.a) z=(frd e.a)] (rau [z p.y] =(q.y 0)) :: ++ lth |= [a=[e=@s a=@u] b=[e=@s a=@u]] ^- ? - ?: =(e.a e.b) (^^lth a.a a.b) + ?: =(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) + (^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) :: ++ lte |= [a=[e=@s a=@u] b=[e=@s a=@u]] ^- ? - ?: =(e.a e.b) (^^lte a.a a.b) + ?: =(e.a e.b) (^lte a.a a.b) =+ c=(cmp:si (ibl a) (ibl b)) ?: =(c -1) & ?: =(c --1) | ?: =((cmp:si e.a e.b) -1) - (^^lte a.a (lsh 0 (abs:si (dif:si e.a e.b)) a.b)) - (^^lte (lsh 0 (abs:si (dif:si e.a e.b)) a.a) a.b) + (^lte a.a (lsh 0 (abs:si (dif:si e.a e.b)) a.b)) + (^lte (lsh 0 (abs:si (dif:si e.a e.b)) a.a) a.b) :: ++ equ |= [a=[e=@s a=@u] b=[e=@s a=@u]] ^- ? @@ -1591,18 +1418,18 @@ a(a (rsh 0 1 a.a), e (sum:si e.a --1)) ?> ?| =(ma prc) - &(!=(den %i) =(e.a emn) (^^lth ma prc)) + &(!=(den %i) =(e.a emn) (^lth ma prc)) == a :: :: assumes that (met 0 a.a) <= prc!! ++ xpd |= [a=[e=@s a=@u]] - =+ ?: =(den %i) (^^sub prc (met 0 a.a)) + =+ ?: =(den %i) (^sub prc (met 0 a.a)) =+ ^= q =+ w=(dif:si e.a emn) ?: (syn:si w) (abs:si w) 0 - (min q (^^sub prc (met 0 a.a))) + (min q (^sub prc (met 0 a.a))) a(e (dif:si e.a (sun:si -)), a (lsh 0 - a.a)) :: :: in order: floor, ceiling, nearest (even, away from 0, toward 0), larger, smaller @@ -1618,7 +1445,7 @@ =+ m=(met 0 a.a) =+ ^= q =+ ^= f :: reduce precision - ?: (^gth m prc) (^^sub m prc) 0 + ?: (gth m prc) (^sub m prc) 0 =+ ^= g %- abs:si :: enforce min. exp ?: =(den %i) --0 ?: =((cmp:si e.a emn) -1) (dif:si emn e.a) --0 @@ -1631,11 +1458,11 @@ ?- 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)] + %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) :: expand @@ -1646,22 +1473,22 @@ %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)) + =+ 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) :: halfway rounds to even ?~ (dis a.a 1) a a(a +(a.a)) - ?: (^^lth b y) 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)) + ?: (^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)) + ?: (^lth b y) a a(a +(a.a)) == ?~ a.a [%f & zer] :: @@ -1670,37 +1497,37 @@ :: ++ drg :: dragon4 |= [a=[e=@s a=@u]] ^- [@s @u] - =. a ?: (^^lth (met 0 a.a) prc) (xpd a) a + =. a ?: (^lth (met 0 a.a) prc) (xpd a) 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) =+ m=(lsh 0 ?:((syn:si e.a) (abs:si e.a) 0) 1) - =+ [k=--0 q=(^^div (^^add s 9) 10)] - |- ?: (^^lth r q) + =+ [k=--0 q=(^div (^add s 9) 10)] + |- ?: (^lth r q) %= $ k (dif:si k --1) - r (^^mul r 10) - m (^^mul m 10) + r (^mul r 10) + m (^mul m 10) == - |- ?: (^gte (^^add (^^mul r 2) m) (^^mul s 2)) - $(s (^^mul s 10), k (sum:si k --1)) + |- ?: (gte (^add (^mul r 2) m) (^mul s 2)) + $(s (^mul s 10), k (sum:si k --1)) =+ [u=0 o=0] |- - =+ v=(dvr (^^mul r 10) s) + =+ v=(dvr (^mul r 10) s) => %= . k (dif:si k --1) u p.v r q.v - m (^^mul m 10) + m (^mul m 10) == - =+ l=(^^lth (^^mul r 2) m) + =+ l=(^lth (^mul r 2) m) =+ ^= h - ?| (^^lth (^^mul s 2) m) - (^gth (^^mul r 2) (^^sub (^^mul s 2) m)) + ?| (^lth (^mul s 2) m) + (gth (^mul r 2) (^sub (^mul s 2) m)) == ?: &(!l !h) - $(o (^^add (^^mul o 10) u)) - =+ q=|(&(!l h) &(=(l h) (^gte (^^mul r 2) s))) - =. o (^^add (^^mul o 10) ?:(q +(u) u)) + $(o (^add (^mul o 10) u)) + =+ q=|(&(!l h) &(=(l h) (gte (^mul r 2) s))) + =. o (^add (^mul o 10) ?:(q +(u) u)) [k o] :: ++ ned @@ -1713,8 +1540,12 @@ ?: |(?=([%n *] a) ?=([%i *] a)) a a(e (sum:si e.a b)) :: + ++ fli + |= [a=fn] ^- fn + ?-(-.a %f a(s !s.a), %i a(s !s.a), %n a) + :: ++ swr ?+(r r %d %u, %u %d) - ++ prc ?>((^gth p 1) p) + ++ prc ?>((gth p 1) p) ++ den d ++ emn v ++ emm (sum:si emn (sun:si (dec prc))) @@ -1725,6 +1556,174 @@ ++ lfe (sum:si emx (sun:si prc)) :: 2^lfe is larger than all floats ++ zer [e=--0 a=0] -- + |% + ++ rou + |= [a=fn] ^- fn + ?. ?=([%f *] a) a + ?~ a.a [%f s.a zer] + ?: s.a (^rou +>.a) + =.(r swr (fli (^rou +>.a))) + :: + ++ syn + |= [a=fn] ^- ? + ?-(-.a %f s.a, %i s.a, %n &) + :: + ++ abs + |= [a=fn] ^- fn + ?: ?=([%f *] a) [%f & e.a a.a] + ?: ?=([%i *] a) [%i &] [%n ~] + :: + ++ 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 |) + :: + ++ ead :: exact 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)) ?~(a.a b a) + [%f ?:(=(r %d) &(s.a s.b) |(s.a s.b)) zer] + ?: =(s.a s.b) + ?: s.a (^add +>.a +>.b &) + (fli (^add +>.a +>.b &)) + ?: s.a (^sub +>.a +>.b &) + (^sub +>.b +>.a &) + :: + ++ sub + |= [a=fn b=fn] ^- fn (add a (fli b)) + :: + ++ 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 :: exact multiply + |= [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 + |= [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 :: a * b + c + |= [a=fn b=fn c=fn] ^- fn + (add (emu a b) c) + :: + ++ sqt :: square root + |= [a=fn] ^- fn + ?: ?=([%n *] a) [%n ~] + ?: ?=([%i *] a) ?:(s.a a [%n ~]) + ?~ a.a [%f s.a zer] + ?: s.a (^sqt +>.a) [%n ~] + :: + ++ inv + |= [a=fn] ^- fn + (div [%f & --0 1] a) + :: + ++ sun + |= [a=@u] ^- fn + (rou [%f & --0 a]) + :: + ++ san + |= [a=@s] ^- fn + =+ b=(old:si a) + (rou [%f -.b --0 +.b]) + :: + ++ 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) + :: + ++ lte + |= [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 (^lte +>.a +>.b) (^lte +>.b +>.a) + :: + ++ 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) + :: + ++ gte + |= [a=fn b=fn] ^- (unit ,?) (lte b a) + :: + ++ gth + |= [a=fn b=fn] ^- (unit ,?) (lth b a) + :: + ++ drg :: float to decimal + |= [a=fn] ^- dn + ?: ?=([%n *] a) [%n ~] + ?: ?=([%i *] a) [%i s.a] + ?~ a.a [%d s.a --0 0] + [%d s.a (^drg +>.a)] + :: + ++ grd :: decimal to float + |= [a=dn] ^- fn + ?: ?=([%n *] a) [%n ~] + ?: ?=([%i *] a) [%i s.a] + => .(r %n) :: always rnd nearest + =+ 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)]) -- :: ++ ff :: ieee754 format From 216eed690e216081a5fd2ee4e49de0b3cf431a54 Mon Sep 17 00:00:00 2001 From: Max G Date: Fri, 31 Jul 2015 05:01:20 +0300 Subject: [PATCH 12/20] ++drg jet --- arvo/hoon.hoon | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/arvo/hoon.hoon b/arvo/hoon.hoon index 9cb89bc7cd..6e4e73e22d 100644 --- a/arvo/hoon.hoon +++ b/arvo/hoon.hoon @@ -1,4 +1,4 @@ -!::::: :::::::::::::::::::::::::::::::::::::::::::::::::::::: +:::::: :::::::::::::::::::::::::::::::::::::::::::::::::::::: :::::: :::::: Preface :::::: :::::: :::::::::::::::::::::::::::::::::::::::::::::::::::::: ?> ?=(@ .) :: atom subject @@ -1288,6 +1288,7 @@ :: d=behavior: return denormals, flush denormals to zero, :: infinite exponent range => + ~% %cofl +> ~ |% :: don't put 0s into [@s @u] args ++ rou |= [a=[e=@s a=@u]] ^- fn (rau a &) @@ -1526,7 +1527,7 @@ == ?: &(!l !h) $(o (^add (^mul o 10) u)) - =+ q=|(&(!l h) &(=(l h) (gte (^mul r 2) s))) + =+ q=&(h |(!l (gte (^mul r 2) s))) =. o (^add (^mul o 10) ?:(q +(u) u)) [k o] :: @@ -1556,6 +1557,7 @@ ++ lfe (sum:si emx (sun:si prc)) :: 2^lfe is larger than all floats ++ zer [e=--0 a=0] -- + ~% %fl + ~ |% ++ rou |= [a=fn] ^- fn @@ -1708,7 +1710,7 @@ ++ gth |= [a=fn b=fn] ^- (unit ,?) (lth b a) :: - ++ drg :: float to decimal + ++ drg ~/ %drg :: float to decimal |= [a=fn] ^- dn ?: ?=([%n *] a) [%n ~] ?: ?=([%i *] a) [%i s.a] @@ -5537,8 +5539,8 @@ !=(c 0) == =+ ^= l ?~ (mod d h) - (div d h) - +((div d h)) + (div d h) + +((div d h)) =+ r=(sub d (mul h (dec l))) =+ [t=0 j=1 k=1] =. t |- ^- @ From 74d0d1b337f40bc4454dc782aa45c0fee535a8d2 Mon Sep 17 00:00:00 2001 From: Max G Date: Sat, 1 Aug 2015 06:30:13 +0300 Subject: [PATCH 13/20] fix ++drg mismatch, ieee754 conversion --- arvo/hoon.hoon | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/arvo/hoon.hoon b/arvo/hoon.hoon index 6e4e73e22d..8373564013 100644 --- a/arvo/hoon.hoon +++ b/arvo/hoon.hoon @@ -1729,14 +1729,14 @@ -- :: ++ ff :: ieee754 format - |_ [[w=@u p=@u b=@s f=?] r=?(%n %u %d %z %a)] + |_ [[w=@u p=@u b=@s] r=?(%n %u %d %z %a)] :: ++ sz +((^add w p)) ++ sb (bex (^add w p)) + ++ me (dif:si (dif:si --1 b) (sun:si p)) :: ++ pa - =+ i=(dif:si (dif:si --1 b) (sun:si p)) - %*(. fl p +(p), v i, w (^sub (bex w) 3), d ?:(f %f %d), r r) + %*(. fl p +(p), v me, w (^sub (bex w) 3), d %d, r r) :: ++ sea |= [a=@r] ^- fn @@ -1744,10 +1744,10 @@ =+ e=(cut 0 [p w] a) =+ s==(0 (cut 0 [(^add p w) 1] a)) ?: =(e 0) - ?: =(f 0) [%f s --0 0] [%f s (dif:si --1 b) f] + ?: =(f 0) [%f s --0 0] [%f s me f] ?: =(e (fil 0 w 1)) ?: =(f 0) [%i s] [%n ~] - =+ q=(dif:si (sun:si e) (sum:si b (sun:si p))) + =+ q=:(sum:si (sun:si e) me -1) =+ r=(^add f (bex p)) [%f s q r] :: @@ -1762,10 +1762,10 @@ ?~ a.a ?: s.a `@r`0 sb =+ ma=(met 0 a.a) ?. =(ma +(p)) - ?> =(e.a (dif:si --1 b)) + ?> =(e.a me) ?> (^lth ma +(p)) ?: s.a `@r`a.a (^add a.a sb) - =+ q=(sum:si (sum:si e.a (sun:si p)) b) + =+ 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) :: @@ -1807,7 +1807,7 @@ ~% %rd + ~ |% ++ ma - %*(. ff w 11, p 52, b --1.023, f %.n) + %*(. ff w 11, p 52, b --1.023) ++ sea |= [a=@rd] (sea:ma a) ++ bit @@ -1842,7 +1842,7 @@ ~% %rs + ~ |% ++ ma - %*(. ff w 8, p 23, b --127, f %.n) + %*(. ff w 8, p 23, b --127) ++ sea |= [a=@rs] (sea:ma a) ++ bit @@ -1877,7 +1877,7 @@ ~% %rq + ~ |% ++ ma - %*(. ff w 15, p 112, b --16.383, f %.n) + %*(. ff w 15, p 112, b --16.383) ++ sea |= [a=@rq] (sea:ma a) ++ bit @@ -1911,7 +1911,7 @@ ++ rh |% ++ ma - %*(. ff w 5, p 10, b --15, f %.n) + %*(. ff w 5, p 10, b --15) ++ sea |= [a=@rh] (sea:ma a) ++ bit From f6384855a172b136e31e0191b4891f4992bd5f51 Mon Sep 17 00:00:00 2001 From: Max G Date: Sun, 2 Aug 2015 00:04:25 +0300 Subject: [PATCH 14/20] ++lug jet --- arvo/hoon.hoon | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/arvo/hoon.hoon b/arvo/hoon.hoon index 8373564013..5bf79abcb2 100644 --- a/arvo/hoon.hoon +++ b/arvo/hoon.hoon @@ -1423,19 +1423,20 @@ == a :: - :: assumes that (met 0 a.a) <= prc!! ++ xpd |= [a=[e=@s a=@u]] - =+ ?: =(den %i) (^sub prc (met 0 a.a)) + =+ ma=(met 0 a.a) + ?< =(ma 0) + =+ ?: =(den %i) (^sub prc ma) =+ ^= q =+ w=(dif:si e.a emn) ?: (syn:si w) (abs:si w) 0 - (min q (^sub prc (met 0 a.a))) + (min q (^sub prc ma)) a(e (dif:si e.a (sun:si -)), a (lsh 0 - a.a)) :: :: in order: floor, ceiling, nearest (even, away from 0, toward 0), larger, smaller :: t=sticky bit - ++ lug + ++ lug ~/ %lug |= [t=?(%fl %ce %ne %na %nt %lg %sm) a=[e=@s a=@u] s=?] ^- fn :: =- :: if !den, flush denormals to zero @@ -1468,7 +1469,7 @@ :: =. a (xpd a) :: expand :: - =. a %- unj + =. a ?- t %fl a %lg a(a +(a.a)) @@ -1491,12 +1492,14 @@ ?: =(b y) ?: s a a(a +(a.a)) ?: (^lth b y) a a(a +(a.a)) == + :: + =. a %- unj a ?~ a.a [%f & zer] :: ?: =(den %i) [%f & a] ?: =((cmp:si emx e.a) -1) [%i &] [%f & a] :: enforce max. exp :: - ++ drg :: dragon4 + ++ drg ~/ %drg :: dragon4 |= [a=[e=@s a=@u]] ^- [@s @u] =. a ?: (^lth (met 0 a.a) prc) (xpd a) a =+ r=(lsh 0 ?:((syn:si e.a) (abs:si e.a) 0) a.a) @@ -1557,7 +1560,6 @@ ++ lfe (sum:si emx (sun:si prc)) :: 2^lfe is larger than all floats ++ zer [e=--0 a=0] -- - ~% %fl + ~ |% ++ rou |= [a=fn] ^- fn @@ -1710,7 +1712,7 @@ ++ gth |= [a=fn b=fn] ^- (unit ,?) (lth b a) :: - ++ drg ~/ %drg :: float to decimal + ++ drg :: float to decimal |= [a=fn] ^- dn ?: ?=([%n *] a) [%n ~] ?: ?=([%i *] a) [%i s.a] From 032e7d7dcf954dfaa71a026e287b1717b4d628d6 Mon Sep 17 00:00:00 2001 From: Max G Date: Mon, 3 Aug 2015 19:59:40 +0300 Subject: [PATCH 15/20] more cleanup --- arvo/hoon.hoon | 23 ++++++----------------- 1 file changed, 6 insertions(+), 17 deletions(-) diff --git a/arvo/hoon.hoon b/arvo/hoon.hoon index 5bf79abcb2..ed6e2b6af4 100644 --- a/arvo/hoon.hoon +++ b/arvo/hoon.hoon @@ -1371,7 +1371,7 @@ =+ [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) :: enforce even exponent + (^add - 1) a(e (dif:si e.a (sun:si -)), a (lsh 0 - a.a)) =+ [y=(^sqt a.a) z=(frd e.a)] (rau [z p.y] =(q.y 0)) @@ -1412,17 +1412,6 @@ |- ?: =((end 0 1 a.a) 1) a $(a.a (rsh 0 1 a.a), e.a (sum:si e.a --1)) :: - ++ unj :: used internally by rounding - |= [a=[e=@s a=@u]] - =+ ma=(met 0 a.a) - ?: =(ma +(prc)) - a(a (rsh 0 1 a.a), e (sum:si e.a --1)) - ?> ?| - =(ma prc) - &(!=(den %i) =(e.a emn) (^lth ma prc)) - == - a - :: ++ xpd |= [a=[e=@s a=@u]] =+ ma=(met 0 a.a) @@ -1434,12 +1423,11 @@ (min q (^sub prc ma)) a(e (dif:si e.a (sun:si -)), a (lsh 0 - a.a)) :: - :: in order: floor, ceiling, nearest (even, away from 0, toward 0), larger, smaller - :: t=sticky bit + :: in order: floor, ceiling, nearest (even, away from 0, toward 0), + :: larger, smaller; t=sticky bit ++ lug ~/ %lug |= [t=?(%fl %ce %ne %na %nt %lg %sm) a=[e=@s a=@u] s=?] ^- fn - :: - =- :: if !den, flush denormals to zero + =- ?. =(den %f) - ?. ?=([%f *] -) - ?: =((met 0 ->+>) prc) - [%f & zer] @@ -1493,7 +1481,8 @@ ?: (^lth b y) a a(a +(a.a)) == :: - =. a %- unj 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] From f78f794d42db6e8cd444225906141e3edeb44631 Mon Sep 17 00:00:00 2001 From: Max G Date: Mon, 3 Aug 2015 20:33:57 +0300 Subject: [PATCH 16/20] ++toi --- arvo/hoon.hoon | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/arvo/hoon.hoon b/arvo/hoon.hoon index ed6e2b6af4..1247ad6c63 100644 --- a/arvo/hoon.hoon +++ b/arvo/hoon.hoon @@ -1,4 +1,4 @@ -:::::: :::::::::::::::::::::::::::::::::::::::::::::::::::::: +!::::: :::::::::::::::::::::::::::::::::::::::::::::::::::::: :::::: :::::: Preface :::::: :::::: :::::::::::::::::::::::::::::::::::::::::::::::::::::: ?> ?=(@ .) :: atom subject @@ -1523,6 +1523,18 @@ =. o (^add (^mul o 10) ?:(q +(u) u)) [k o] :: + ++ toi + |= [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)] + :: ++ ned |= [a=fn] ^- [%f s=? e=@s a=@u] ?: ?=([%f *] a) a @@ -1717,6 +1729,13 @@ ?: (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)]) + :: + ++ toi :: round to integer + |= [a=fn] ^- fn + ?. ?=([%f *] a) a + ?~ a.a [%f s.a zer] + ?: s.a (^toi +>.a) + (fli =.(r swr (^toi +>.a))) -- :: ++ ff :: ieee754 format From ca9452c21b0a1a9d8b08226ff03dd5996deeb6c9 Mon Sep 17 00:00:00 2001 From: Max G Date: Tue, 4 Aug 2015 06:00:09 +0300 Subject: [PATCH 17/20] rounding modes for rd, rq, rs --- arvo/hoon.hoon | 44 +++++++++++++++++++++++++------------------- 1 file changed, 25 insertions(+), 19 deletions(-) diff --git a/arvo/hoon.hoon b/arvo/hoon.hoon index 1247ad6c63..9cb385bd90 100644 --- a/arvo/hoon.hoon +++ b/arvo/hoon.hoon @@ -1,4 +1,4 @@ -!::::: :::::::::::::::::::::::::::::::::::::::::::::::::::::: +:::::: :::::::::::::::::::::::::::::::::::::::::::::::::::::: :::::: :::::: Preface :::::: :::::: :::::::::::::::::::::::::::::::::::::::::::::::::::::: ?> ?=(@ .) :: atom subject @@ -1425,7 +1425,8 @@ :: :: in order: floor, ceiling, nearest (even, away from 0, toward 0), :: larger, smaller; t=sticky bit - ++ lug ~/ %lug + ++ lug + ~/ %lug |= [t=?(%fl %ce %ne %na %nt %lg %sm) a=[e=@s a=@u] s=?] ^- fn =- ?. =(den %f) - @@ -1488,7 +1489,8 @@ ?: =(den %i) [%f & a] ?: =((cmp:si emx e.a) -1) [%i &] [%f & a] :: enforce max. exp :: - ++ drg ~/ %drg :: dragon4 + ++ drg :: dragon4 + ~/ %drg |= [a=[e=@s a=@u]] ^- [@s @u] =. a ?: (^lth (met 0 a.a) prc) (xpd a) a =+ r=(lsh 0 ?:((syn:si e.a) (abs:si e.a) 0) a.a) @@ -1724,7 +1726,7 @@ |= [a=dn] ^- fn ?: ?=([%n *] a) [%n ~] ?: ?=([%i *] a) [%i s.a] - => .(r %n) :: always rnd nearest + => .(r %n) =+ q=(abs:si e.a) ?: (syn:si e.a) (mul [%f s.a --0 a.a] [%f & e.a (pow 5 q)]) @@ -1814,10 +1816,10 @@ ++ rylq |= a=dn ^- @rq (grd:rq a) :: ++ rd - ~% %rd + ~ - |% + ~% %rd +> ~ + |_ r=?(%n %u %d %z) ++ ma - %*(. ff w 11, p 52, b --1.023) + %*(. ff w 11, p 52, b --1.023, r r) ++ sea |= [a=@rd] (sea:ma a) ++ bit @@ -1849,10 +1851,10 @@ -- :: ++ rs - ~% %rs + ~ - |% + ~% %rs +> ~ + |_ r=?(%n %u %d %z) ++ ma - %*(. ff w 8, p 23, b --127) + %*(. ff w 8, p 23, b --127, r r) ++ sea |= [a=@rs] (sea:ma a) ++ bit @@ -1884,10 +1886,10 @@ -- :: ++ rq - ~% %rq + ~ - |% + ~% %rq +> ~ + |_ r=?(%n %u %d %z) ++ ma - %*(. ff w 15, p 112, b --16.383) + %*(. ff w 15, p 112, b --16.383, r r) ++ sea |= [a=@rq] (sea:ma a) ++ bit @@ -1919,9 +1921,9 @@ -- :: ++ rh - |% + |_ r=?(%n %u %d %z) ++ ma - %*(. ff w 5, p 10, b --15) + %*(. ff w 5, p 10, b --15, r r) ++ sea |= [a=@rh] (sea:ma a) ++ bit @@ -5536,11 +5538,13 @@ %+ shay (add b 32) (add (lsh 3 b q) (mix k (fil 3 b 0x5c))) :: - ++ pbk ~/ %pbk :: PBKDF2-HMAC-SHA256 + ++ pbk :: PBKDF2-HMAC-SHA256 + ~/ %pbk |= [p=@ s=@ c=@ d=@] (pbl p (met 3 p) s (met 3 s) c d) :: - ++ pbl ~/ %pbl :: w/length + ++ pbl :: w/length + ~/ %pbl |= [p=@ pl=@ s=@ sl=@ c=@ d=@] => .(p (end 3 pl p), s (end 3 sl s)) =+ h=32 @@ -5563,11 +5567,13 @@ $(t (add t (lsh 3 (mul (dec j) h) f)), j +(j)) (end 3 d t) :: - ++ hsh ~/ %hsh :: scrypt + ++ hsh :: scrypt + ~/ %hsh |= [p=@ s=@ n=@ r=@ z=@ d=@] (hsl p (met 3 p) s (met 3 s) n r z d) :: - ++ hsl ~/ %hsl :: w/length + ++ hsl :: w/length + ~/ %hsl |= [p=@ pl=@ s=@ sl=@ n=@ r=@ z=@ d=@] =| v=(list (list ,@)) => .(p (end 3 pl p), s (end 3 sl s)) From b954bb25cd0355fedcc158d89a94ad2756f61699 Mon Sep 17 00:00:00 2001 From: Max G Date: Wed, 5 Aug 2015 04:27:27 +0300 Subject: [PATCH 18/20] minor parser improvement --- arvo/hoon.hoon | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/arvo/hoon.hoon b/arvo/hoon.hoon index 9cb385bd90..9d4a3cf0b7 100644 --- a/arvo/hoon.hoon +++ b/arvo/hoon.hoon @@ -4086,7 +4086,7 @@ %+ cook royl-cell ;~ pose ;~ plug - (easy %f) + (easy %d) ;~ pose (cold | hep) (easy &) == ;~ plug dim:ag ;~ pose @@ -4122,17 +4122,15 @@ == :: ++ royl-cell - |= $? [%f a=? b=[c=@ [d=@ e=@] f=? i=@]] + |= $? [%d a=? b=[c=@ [d=@ e=@] f=? i=@]] [%i a=?] [%n ~] == ^- dn - ?. ?=([%f *] +<) +< + ?. ?=([%d *] +<) +< =+ ^= h (dif:si (new:si f.b i.b) (sun:si d.b)) - |- ?. =(d.b 0) - $(c.b (mul c.b 10), d.b (dec d.b)) - [%d a h (add c.b e.b)] + [%d a h (add (mul c.b (pow 10 d.b)) e.b)] :: ++ tash ~+ From f6a5641259ae7e0b23eb1be4b2050ebe8c46ca15 Mon Sep 17 00:00:00 2001 From: Max G Date: Wed, 5 Aug 2015 05:52:07 +0300 Subject: [PATCH 19/20] ++toi:ff --- arvo/hoon.hoon | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/arvo/hoon.hoon b/arvo/hoon.hoon index 9d4a3cf0b7..57dc827ae9 100644 --- a/arvo/hoon.hoon +++ b/arvo/hoon.hoon @@ -1737,7 +1737,7 @@ ?. ?=([%f *] a) a ?~ a.a [%f s.a zer] ?: s.a (^toi +>.a) - (fli =.(r swr (^toi +>.a))) + =.(r swr (fli (^toi +>.a))) -- :: ++ ff :: ieee754 format @@ -1789,6 +1789,13 @@ |= [a=@r] ^- @s (dif:si (sun:si (cut 0 [p w] a)) b) :: + ++ toi + |= [a=@r] ^- (unit ,@s) + =+ b=(toi:pa (sea a)) + ?. ?=([%f *] b) ~ :- ~ + =+ c=(^mul (bex (abs:si e.b)) a.b) + (new:si s.b c) + :: ++ add |= [a=@r b=@r] (bif (add:pa (sea a) (sea b))) ++ sub |= [a=@r b=@r] (bif (sub:pa (sea a) (sea b))) ++ mul |= [a=@r b=@r] (bif (mul:pa (sea a) (sea b))) @@ -1846,6 +1853,7 @@ ++ gth ~/ %gth |= [a=@rd b=@rd] ~| %rd-fail (gth:ma a b) ++ sig |= [a=@rd] (sig:ma a) ++ exp |= [a=@rd] (exp:ma a) + ++ toi |= [a=@rd] (toi:ma a) ++ drg |= [a=@rd] (drg:ma a) ++ grd |= [a=dn] (grd:ma a) -- @@ -1870,7 +1878,7 @@ ++ fma ~/ %fma |= [a=@rs b=@rs c=@rs] ^- @rs ~| %rs-fail (fma:ma a b c) ++ sqt ~/ %sqt - |= [a=@rs] ^- @rs (sqt:ma a) + |= [a=@rs] ^- @rs ~| %rs-fail (sqt:ma a) :: ++ sun |= [a=@u] ^- @rs (sun:ma a) ++ san |= [a=@s] ^- @rs (san:ma a) @@ -1881,6 +1889,7 @@ ++ gth ~/ %gth |= [a=@rs b=@rs] ~| %rs-fail (gth:ma a b) ++ sig |= [a=@rs] (sig:ma a) ++ exp |= [a=@rs] (exp:ma a) + ++ toi |= [a=@rs] (toi:ma a) ++ drg |= [a=@rs] (drg:ma a) ++ grd |= [a=dn] (grd:ma a) -- @@ -1916,6 +1925,7 @@ ++ gth ~/ %gth |= [a=@rq b=@rq] ~| %rq-fail (gth:ma a b) ++ sig |= [a=@rq] (sig:ma a) ++ exp |= [a=@rq] (exp:ma a) + ++ toi |= [a=@rq] (toi:ma a) ++ drg |= [a=@rq] (drg:ma a) ++ grd |= [a=dn] (grd:ma a) -- @@ -1942,6 +1952,7 @@ ++ gth |= [a=@rh b=@rh] ~| %rh-fail (gth:ma a b) ++ sig |= [a=@rh] (sig:ma a) ++ exp |= [a=@rh] (exp:ma a) + ++ toi |= [a=@rh] (toi:ma a) ++ drg |= [a=@rh] (drg:ma a) ++ grd |= [a=dn] (grd:ma a) -- From 7f852f07d615085c63956158e3f18166f3f4b42e Mon Sep 17 00:00:00 2001 From: Galen Wolfe-Pauly Date: Wed, 5 Aug 2015 15:07:16 -0700 Subject: [PATCH 20/20] fix toc --- pub/tree/src/js/components/Reactify.coffee | 4 +- .../src/js/components/TocComponent.coffee | 11 +- pub/tree/src/js/main.js | 154 +++++++++++++++--- 3 files changed, 137 insertions(+), 32 deletions(-) diff --git a/pub/tree/src/js/components/Reactify.coffee b/pub/tree/src/js/components/Reactify.coffee index 493b32be47..4a5aacd19e 100644 --- a/pub/tree/src/js/components/Reactify.coffee +++ b/pub/tree/src/js/components/Reactify.coffee @@ -5,13 +5,13 @@ load = React.createFactory require './LoadComponent.coffee' codemirror = require './CodeMirror.coffee' list = require './ListComponent.coffee' kids = require './KidsComponent.coffee' -# toc = require './TocComponent.coffee' XX uh, broken with a typo +toc = require './TocComponent.coffee' lost = recl render: -> (div {}, "lost") components = kids:kids list:list lost:lost - # toc:toc + toc:toc codemirror:codemirror module.exports = recl diff --git a/pub/tree/src/js/components/TocComponent.coffee b/pub/tree/src/js/components/TocComponent.coffee index 0dfd0642e9..4a66972bf4 100644 --- a/pub/tree/src/js/components/TocComponent.coffee +++ b/pub/tree/src/js/components/TocComponent.coffee @@ -26,7 +26,10 @@ module.exports = recl @setState @stateFromStore() _click: (e) -> - document.location.hash = $(e). + console.log 'click' + document.location.hash = @urlsafe $(e.target).text() + + urlsafe: (str) -> str.toLowerCase().replace(/\ /g, "-") componentDidMount: -> @int = setInterval @checkHash,100 @@ -36,7 +39,7 @@ module.exports = recl if document.location.hash? and document.location.hash isnt @hash hash = document.location.hash.slice(1) for k,v of @state.tocs - if v.t is hash + if hash is @urlsafe v.t @hash = document.location.hash $(window).scrollTop v.e.offset().top break @@ -59,5 +62,7 @@ module.exports = recl c render: -> + onClick = @_click (div {className:'toc'}, @state.tocs.map (i) -> - l.push (React.DOM[i.h] {onClick:@_click}, i.t)) \ No newline at end of file + (React.DOM[i.h] {onClick}, i.t) + ) \ No newline at end of file diff --git a/pub/tree/src/js/main.js b/pub/tree/src/js/main.js index 37e2b6f327..e693d8a4a9 100644 --- a/pub/tree/src/js/main.js +++ b/pub/tree/src/js/main.js @@ -82,8 +82,7 @@ module.exports = { }; - -},{"../dispatcher/Dispatcher.coffee":10,"../persistence/TreePersistence.coffee":16}],2:[function(require,module,exports){ +},{"../dispatcher/Dispatcher.coffee":11,"../persistence/TreePersistence.coffee":17}],2:[function(require,module,exports){ var BodyComponent, TreeActions, TreeStore, a, div, reactify, recl, ref, slice = [].slice; @@ -305,8 +304,7 @@ module.exports = recl({ }); - -},{"../actions/TreeActions.coffee":1,"../stores/TreeStore.coffee":17,"./BodyComponent.coffee":4,"./Reactify.coffee":9}],3:[function(require,module,exports){ +},{"../actions/TreeActions.coffee":1,"../stores/TreeStore.coffee":18,"./BodyComponent.coffee":4,"./Reactify.coffee":9}],3:[function(require,module,exports){ var TreeActions, TreeStore, code, div, load, recl, ref, span; load = React.createFactory(require('./LoadComponent.coffee')); @@ -391,8 +389,7 @@ module.exports = function(queries, Child) { }; - -},{"../actions/TreeActions.coffee":1,"../stores/TreeStore.coffee":17,"./LoadComponent.coffee":8}],4:[function(require,module,exports){ +},{"../actions/TreeActions.coffee":1,"../stores/TreeStore.coffee":18,"./LoadComponent.coffee":8}],4:[function(require,module,exports){ var div, query, reactify, recl; reactify = React.createFactory(require('./Reactify.coffee')); @@ -419,7 +416,6 @@ module.exports = query({ })); - },{"./Async.coffee":3,"./Reactify.coffee":9}],5:[function(require,module,exports){ var div, recl, ref, textarea; @@ -443,7 +439,6 @@ module.exports = recl({ }); - },{}],6:[function(require,module,exports){ var a, div, hr, li, query, reactify, recl, ref, ul; @@ -487,7 +482,6 @@ module.exports = query({ })); - },{"./Async.coffee":3}],7:[function(require,module,exports){ var a, clas, div, h1, li, query, reactify, recl, ref, ul, slice = [].slice; @@ -558,8 +552,7 @@ module.exports = query({ })); - -},{"./Async.coffee":3,"classnames":12}],8:[function(require,module,exports){ +},{"./Async.coffee":3,"classnames":13}],8:[function(require,module,exports){ var div, input, recl, ref, textarea; recl = React.createClass; @@ -597,9 +590,8 @@ module.exports = recl({ }); - },{}],9:[function(require,module,exports){ -var codemirror, components, div, kids, list, load, lost, recl, ref, span; +var codemirror, components, div, kids, list, load, lost, recl, ref, span, toc; recl = React.createClass; @@ -613,6 +605,8 @@ list = require('./ListComponent.coffee'); kids = require('./KidsComponent.coffee'); +toc = require('./TocComponent.coffee'); + lost = recl({ render: function() { return div({}, "lost"); @@ -623,6 +617,7 @@ components = { kids: kids, list: list, lost: lost, + toc: toc, codemirror: codemirror }; @@ -651,8 +646,117 @@ module.exports = recl({ }); +},{"./CodeMirror.coffee":5,"./KidsComponent.coffee":6,"./ListComponent.coffee":7,"./LoadComponent.coffee":8,"./TocComponent.coffee":10}],10:[function(require,module,exports){ +var TreeActions, TreeStore, a, clas, div, li, load, reactify, recl, ref, ul; -},{"./CodeMirror.coffee":5,"./KidsComponent.coffee":6,"./ListComponent.coffee":7,"./LoadComponent.coffee":8}],10:[function(require,module,exports){ +clas = require('classnames'); + +TreeStore = require('../stores/TreeStore.coffee'); + +TreeActions = require('../actions/TreeActions.coffee'); + +load = React.createFactory(require('./LoadComponent.coffee')); + +reactify = function(manx) { + return React.createElement(window.tree.reactify, { + manx: manx + }); +}; + +recl = React.createClass; + +ref = [React.DOM.div, React.DOM.a, React.DOM.ul, React.DOM.li, React.DOM.h1], div = ref[0], a = ref[1], ul = ref[2], li = ref[3]; + +module.exports = recl({ + hash: null, + displayName: "TableofContents", + stateFromStore: function() { + var path, ref1, state; + path = (ref1 = this.props.dataPath) != null ? ref1 : TreeStore.getCurr(); + state = { + path: path, + snip: TreeStore.getSnip(), + tree: TreeStore.getTree(path.split("/")), + tocs: this.compute() + }; + return state; + }, + _onChangeStore: function() { + return this.setState(this.stateFromStore()); + }, + _click: function(e) { + console.log('click'); + return document.location.hash = this.urlsafe($(e.target).text()); + }, + urlsafe: function(str) { + return str.toLowerCase().replace(/\ /g, "-"); + }, + componentDidMount: function() { + this.int = setInterval(this.checkHash, 100); + return this.setState(this.stateFromStore()); + }, + checkHash: function() { + var hash, k, ref1, results, v; + if ((document.location.hash != null) && document.location.hash !== this.hash) { + hash = document.location.hash.slice(1); + ref1 = this.state.tocs; + results = []; + for (k in ref1) { + v = ref1[k]; + if (hash === this.urlsafe(v.t)) { + this.hash = document.location.hash; + $(window).scrollTop(v.e.offset().top); + break; + } else { + results.push(void 0); + } + } + return results; + } + }, + componentWillUnmount: function() { + TreeStore.removeChangeListener(this._onChangeStore); + return clearInterval(this.int); + }, + getInitialState: function() { + return this.stateFromStore(); + }, + gotPath: function() { + return TreeStore.gotSnip(this.state.path); + }, + compute: function() { + var $h, $headers, c, h, j, len; + $headers = $('#toc h1, #toc h2, #toc h3, #toc h4'); + c = []; + if ($headers.length === 0) { + return c; + } + for (j = 0, len = $headers.length; j < len; j++) { + h = $headers[j]; + $h = $(h); + c.push({ + h: h.tagName.toLowerCase(), + t: $h.text(), + e: $h + }); + } + return c; + }, + render: function() { + var onClick; + onClick = this._click; + return div({ + className: 'toc' + }, this.state.tocs.map(function(i) { + return React.DOM[i.h]({ + onClick: onClick + }, i.t); + })); + } +}); + + +},{"../actions/TreeActions.coffee":1,"../stores/TreeStore.coffee":18,"./LoadComponent.coffee":8,"classnames":13}],11:[function(require,module,exports){ var Dispatcher; Dispatcher = require('flux').Dispatcher; @@ -673,8 +777,7 @@ module.exports = _.extend(new Dispatcher(), { }); - -},{"flux":13}],11:[function(require,module,exports){ +},{"flux":14}],12:[function(require,module,exports){ var rend; rend = React.render; @@ -820,8 +923,7 @@ $(function() { }); - -},{"./actions/TreeActions.coffee":1,"./components/AnchorComponent.coffee":2,"./components/BodyComponent.coffee":4,"./components/Reactify.coffee":9,"./persistence/TreePersistence.coffee":16}],12:[function(require,module,exports){ +},{"./actions/TreeActions.coffee":1,"./components/AnchorComponent.coffee":2,"./components/BodyComponent.coffee":4,"./components/Reactify.coffee":9,"./persistence/TreePersistence.coffee":17}],13:[function(require,module,exports){ /*! Copyright (c) 2015 Jed Watson. Licensed under the MIT License (MIT), see @@ -872,7 +974,7 @@ $(function() { }()); -},{}],13:[function(require,module,exports){ +},{}],14:[function(require,module,exports){ /** * Copyright (c) 2014-2015, Facebook, Inc. * All rights reserved. @@ -884,7 +986,7 @@ $(function() { module.exports.Dispatcher = require('./lib/Dispatcher') -},{"./lib/Dispatcher":14}],14:[function(require,module,exports){ +},{"./lib/Dispatcher":15}],15:[function(require,module,exports){ /* * Copyright (c) 2014, Facebook, Inc. * All rights reserved. @@ -1136,7 +1238,7 @@ var _prefix = 'ID_'; module.exports = Dispatcher; -},{"./invariant":15}],15:[function(require,module,exports){ +},{"./invariant":16}],16:[function(require,module,exports){ /** * Copyright (c) 2014, Facebook, Inc. * All rights reserved. @@ -1191,7 +1293,7 @@ var invariant = function(condition, format, a, b, c, d, e, f) { module.exports = invariant; -},{}],16:[function(require,module,exports){ +},{}],17:[function(require,module,exports){ module.exports = { get: function(path, query, cb) { var url; @@ -1241,8 +1343,7 @@ module.exports = { }; - -},{}],17:[function(require,module,exports){ +},{}],18:[function(require,module,exports){ var EventEmitter, MessageDispatcher, TreeStore, _cont, _curr, _got_snip, _snip, _tree, clog; EventEmitter = require('events').EventEmitter; @@ -1577,8 +1678,7 @@ TreeStore.dispatchToken = MessageDispatcher.register(function(payload) { module.exports = TreeStore; - -},{"../dispatcher/Dispatcher.coffee":10,"events":18}],18:[function(require,module,exports){ +},{"../dispatcher/Dispatcher.coffee":11,"events":19}],19:[function(require,module,exports){ // Copyright Joyent, Inc. and other Node contributors. // // Permission is hereby granted, free of charge, to any person obtaining a @@ -1881,4 +1981,4 @@ function isUndefined(arg) { return arg === void 0; } -},{}]},{},[11]); +},{}]},{},[12]);