Re: [Haskell-cafe] Why not some subclass of Floating to model NaNs as some handleable bottom?

Thanks Michał, I feel less confused as I realized the non-halting possibility per bottoms, from your hint. I too think the signaling NaN is dreadful enough, so fortunately it's rarely seen nowadays. Actually what's on my mind was roughly something like "Maybe on steroids", I'm aware that NaN semantics breaks `Num` (or descendants) laws, as seen at https://gitlab.haskell.org/ghc/ghc/-/blob/master/libraries/base/GHC/Float.hs https://gitlab.haskell.org/ghc/ghc/-/blob/master/libraries/base/GHC/Float.hs
Note that due to the presence of @NaN@, not all elements of 'Float' have an additive inverse.
Also note that due to the presence of -0, Float's 'Num' instance doesn't have an additive identity
Note that due to the presence of @NaN@, not all elements of 'Float' have an multiplicative inverse.
So it should have been another family of `Num` classes, within which, various NaN related semantics can be legal, amongst which I'd think: * Silent propagation of NaN in arithmetics, like `Maybe` monad does, seems quite acceptable * Identity test, namely `NaN` /= `NaN` - this lacks theoretical ground or not? * Comparison, neither `NaN` > 1 nor `NaN` <= 1 - whether or not there's a theoretical framework for this to hold? Maybe `Boolean` type needs enhancement too to do it? No such family of `Num` classes exists to my aware by now, I just can't help wondering why. Cheers, Compl
On 2021-08-04, at 02:38, Michał J Gajda
wrote: Dear Yue,
Bottom has much weaker semantics than an exception: it means You may never get a result and thus will never handle it!
Another reason is convenience: it is frequently the case that giving NaN in a row of numbers is much more informative than crashing a program with an exception and never printing the result anyway.
Finally IEEE special values have clear propagation semantics: they are basically Maybe on steroids.
The problem with this approach is indeed a silent handling.
But in order to fix this, it is better to add preconditions to specific algorithms that do not allow IEEE special value on input (`isFinite` or `isNotNaN`) and then track the origin of the special value with the methods like those described here: https://skillsmatter.com/skillscasts/14905-agile-functional-data-pipeline-in... https://skillsmatter.com/skillscasts/14905-agile-functional-data-pipeline-in...
Never throw an error without telling exactly why it happened and exactly where to fix it :-). Using bottom is last resort; exceptions likewise. -- Cheers Michał

The infamous `NaN /= NaN` makes only sense for `NaN` originating as a
result, since we cannot compare `NaN`s originating from different
computations.
But it breaks `Eq` instance laws as needed for property tests.
That is why comparison on `NaN` is better handled by `isFinite`,
`isANumber` predicates.
Note that beside `NaN` we also have other anomalous values, like
Underflow, Overflow, +inf and -inf.
These are all error values, and can hardly be treated in any other way.
And they all need to be handled for floating points.
Yes, comparing `NaN` with anything should give a rise to another error value.
That means that the only way out is making Either Error Float, and
then `(>=) :: Either Error Float -> Either Error Float -> Either Error
Bool`
So basically we need to lift all `Num` operations to the `Either Error` Monad.
That is probably best way to fix the problem: once error value
appears, we need to treat it consistently throughout entire
computation.
At the same time, we do not want a single error value to dominate
entire computation, so that is why we treat collections of
computations as computations that give a collection of good results
and a collection of errors separately.
If we take this into consideration, we notice that most interesting
computations occur on collections of values, and thus yield a
collection of results, not just a single output.
That is one takeaway from the referenced presentation on data
analytics in Haskell. (Similar presentation was also well received on
Data Science Europe. It should be on YouTube by now.)
Example of a 3D rotation is instructive: if NaN appears for any single
coordinate, we can get a useful results for all other coordinates, and
thus narrow impact of an error.
If the next step is projection on X-Y coordinates, then NaN or
Over/Under-flow within Z does not affect the result.
To my understanding, that is also the reason why IEEE mandated special
treatment of error values: most of the computations happen on large
matrices, vectors etc, and crashing for each single NaN would be a
true disaster.
It can be even ignored, when the NaN is computed for an energy
component within a single frame of long-running simulation, and the
error disappears within a single time step.
--
Cheers
Michał
On Wed, Aug 4, 2021 at 4:00 PM YueCompl
Thanks Michał,
I feel less confused as I realized the non-halting possibility per bottoms, from your hint.
I too think the signaling NaN is dreadful enough, so fortunately it's rarely seen nowadays.
Actually what's on my mind was roughly something like "Maybe on steroids", I'm aware that NaN semantics breaks `Num` (or descendants) laws, as seen at https://gitlab.haskell.org/ghc/ghc/-/blob/master/libraries/base/GHC/Float.hs
Note that due to the presence of @NaN@, not all elements of 'Float' have an additive inverse.
Also note that due to the presence of -0, Float's 'Num' instance doesn't have an additive identity
Note that due to the presence of @NaN@, not all elements of 'Float' have an multiplicative inverse.
So it should have been another family of `Num` classes, within which, various NaN related semantics can be legal, amongst which I'd think:
* Silent propagation of NaN in arithmetics, like `Maybe` monad does, seems quite acceptable * Identity test, namely `NaN` /= `NaN` - this lacks theoretical ground or not? * Comparison, neither `NaN` > 1 nor `NaN` <= 1 - whether or not there's a theoretical framework for this to hold? Maybe `Boolean` type needs enhancement too to do it?
No such family of `Num` classes exists to my aware by now, I just can't help wondering why.
Cheers, Compl
On 2021-08-04, at 02:38, Michał J Gajda
wrote: Dear Yue,
Bottom has much weaker semantics than an exception: it means You may never get a result and thus will never handle it!
Another reason is convenience: it is frequently the case that giving NaN in a row of numbers is much more informative than crashing a program with an exception and never printing the result anyway.
Finally IEEE special values have clear propagation semantics: they are basically Maybe on steroids.
The problem with this approach is indeed a silent handling.
But in order to fix this, it is better to add preconditions to specific algorithms that do not allow IEEE special value on input (`isFinite` or `isNotNaN`) and then track the origin of the special value with the methods like those described here: https://skillsmatter.com/skillscasts/14905-agile-functional-data-pipeline-in...
Never throw an error without telling exactly why it happened and exactly where to fix it :-). Using bottom is last resort; exceptions likewise. -- Cheers Michał
-- Pozdrawiam Michał

`Eq` relies on the established `Bool` type, then can we solve it, if given algebraic effects & handlers, by Church-encoding an effectful Boolean type? e.g. true === \a b -> a false === \a b -> b cmpWithNaN === \a b -> perform ComparingWithNaN Then (==) and (/=) in `Eq`, together with friends in `Ord` like (>) (<) all return `cmpWithNaN` when at least one NaN is involved. This mechanism is open so all kinds of anomalies can be handled similarly, otherwise even we have all NaN, Inf, Underflow, Overflow etc. handled well, there must be more situations we haven't thought of.
On 2021-08-04, at 22:24, Michal J Gajda
wrote: The infamous `NaN /= NaN` makes only sense for `NaN` originating as a result, since we cannot compare `NaN`s originating from different computations. But it breaks `Eq` instance laws as needed for property tests. That is why comparison on `NaN` is better handled by `isFinite`, `isANumber` predicates. Note that beside `NaN` we also have other anomalous values, like Underflow, Overflow, +inf and -inf. These are all error values, and can hardly be treated in any other way. And they all need to be handled for floating points.
Yes, comparing `NaN` with anything should give a rise to another error value. That means that the only way out is making Either Error Float, and then `(>=) :: Either Error Float -> Either Error Float -> Either Error Bool` So basically we need to lift all `Num` operations to the `Either Error` Monad.
That is probably best way to fix the problem: once error value appears, we need to treat it consistently throughout entire computation. At the same time, we do not want a single error value to dominate entire computation, so that is why we treat collections of computations as computations that give a collection of good results and a collection of errors separately. If we take this into consideration, we notice that most interesting computations occur on collections of values, and thus yield a collection of results, not just a single output.
That is one takeaway from the referenced presentation on data analytics in Haskell. (Similar presentation was also well received on Data Science Europe. It should be on YouTube by now.)
Example of a 3D rotation is instructive: if NaN appears for any single coordinate, we can get a useful results for all other coordinates, and thus narrow impact of an error. If the next step is projection on X-Y coordinates, then NaN or Over/Under-flow within Z does not affect the result.
To my understanding, that is also the reason why IEEE mandated special treatment of error values: most of the computations happen on large matrices, vectors etc, and crashing for each single NaN would be a true disaster. It can be even ignored, when the NaN is computed for an energy component within a single frame of long-running simulation, and the error disappears within a single time step. -- Cheers Michał
On Wed, Aug 4, 2021 at 4:00 PM YueCompl
mailto:compl.yue@icloud.com> wrote: Thanks Michał,
I feel less confused as I realized the non-halting possibility per bottoms, from your hint.
I too think the signaling NaN is dreadful enough, so fortunately it's rarely seen nowadays.
Actually what's on my mind was roughly something like "Maybe on steroids", I'm aware that NaN semantics breaks `Num` (or descendants) laws, as seen at https://gitlab.haskell.org/ghc/ghc/-/blob/master/libraries/base/GHC/Float.hs
Note that due to the presence of @NaN@, not all elements of 'Float' have an additive inverse.
Also note that due to the presence of -0, Float's 'Num' instance doesn't have an additive identity
Note that due to the presence of @NaN@, not all elements of 'Float' have an multiplicative inverse.
So it should have been another family of `Num` classes, within which, various NaN related semantics can be legal, amongst which I'd think:
* Silent propagation of NaN in arithmetics, like `Maybe` monad does, seems quite acceptable * Identity test, namely `NaN` /= `NaN` - this lacks theoretical ground or not? * Comparison, neither `NaN` > 1 nor `NaN` <= 1 - whether or not there's a theoretical framework for this to hold? Maybe `Boolean` type needs enhancement too to do it?
No such family of `Num` classes exists to my aware by now, I just can't help wondering why.
Cheers, Compl
On 2021-08-04, at 02:38, Michał J Gajda
wrote: Dear Yue,
Bottom has much weaker semantics than an exception: it means You may never get a result and thus will never handle it!
Another reason is convenience: it is frequently the case that giving NaN in a row of numbers is much more informative than crashing a program with an exception and never printing the result anyway.
Finally IEEE special values have clear propagation semantics: they are basically Maybe on steroids.
The problem with this approach is indeed a silent handling.
But in order to fix this, it is better to add preconditions to specific algorithms that do not allow IEEE special value on input (`isFinite` or `isNotNaN`) and then track the origin of the special value with the methods like those described here: https://skillsmatter.com/skillscasts/14905-agile-functional-data-pipeline-in...
Never throw an error without telling exactly why it happened and exactly where to fix it :-). Using bottom is last resort; exceptions likewise. -- Cheers Michał
-- Pozdrawiam Michał

Yue,
Yes, it seems it would work
This useful workaround works uses exception effect.
So it may have two disadvantages:
1. You may only catch the effect in a monad that can catch exceptions, like
IO.
2. It does not give a clear path for handling collections of computations.
Note that DSLs also need to redefine Eq as effectful class. Then `(==) ::
Applicative expr => expr a -> expr a -> expr bool`.
This solution may be preferred if You have:
* a DSL already
* additional metadata attached to values, like provenance, security access
level, versioning, Merkle hash, memo hash, equivalence class etc.
* want to handle error values without exposing Yourself to imprecise
exceptions etc.
It has disadvantage of redefining several standard classes, and we do not
yet seem to have a library that would properly provide these type classes
parameterized over any Applicative.
But again, the need for more principled handling of error values will
likely come as software scales.
—
Best regards
Michał
On Wed, 4 Aug 2021 at 16:56 YueCompl
`Eq` relies on the established `Bool` type, then can we solve it, if given algebraic effects & handlers, by Church-encoding an effectful Boolean type? e.g.
true === \a b -> a false === \a b -> b cmpWithNaN === \a b -> perform ComparingWithNaN
Then (==) and (/=) in `Eq`, together with friends in `Ord` like (>) (<) all return `cmpWithNaN` when at least one NaN is involved.
This mechanism is open so all kinds of anomalies can be handled similarly, otherwise even we have all NaN, Inf, Underflow, Overflow etc. handled well, there must be more situations we haven't thought of.
On 2021-08-04, at 22:24, Michal J Gajda
wrote: The infamous `NaN /= NaN` makes only sense for `NaN` originating as a result, since we cannot compare `NaN`s originating from different computations. But it breaks `Eq` instance laws as needed for property tests. That is why comparison on `NaN` is better handled by `isFinite`, `isANumber` predicates. Note that beside `NaN` we also have other anomalous values, like Underflow, Overflow, +inf and -inf. These are all error values, and can hardly be treated in any other way. And they all need to be handled for floating points.
Yes, comparing `NaN` with anything should give a rise to another error value. That means that the only way out is making Either Error Float, and then `(>=) :: Either Error Float -> Either Error Float -> Either Error Bool` So basically we need to lift all `Num` operations to the `Either Error` Monad.
That is probably best way to fix the problem: once error value appears, we need to treat it consistently throughout entire computation. At the same time, we do not want a single error value to dominate entire computation, so that is why we treat collections of computations as computations that give a collection of good results and a collection of errors separately. If we take this into consideration, we notice that most interesting computations occur on collections of values, and thus yield a collection of results, not just a single output.
That is one takeaway from the referenced presentation on data analytics in Haskell. (Similar presentation was also well received on Data Science Europe. It should be on YouTube by now.)
Example of a 3D rotation is instructive: if NaN appears for any single coordinate, we can get a useful results for all other coordinates, and thus narrow impact of an error. If the next step is projection on X-Y coordinates, then NaN or Over/Under-flow within Z does not affect the result.
To my understanding, that is also the reason why IEEE mandated special treatment of error values: most of the computations happen on large matrices, vectors etc, and crashing for each single NaN would be a true disaster. It can be even ignored, when the NaN is computed for an energy component within a single frame of long-running simulation, and the error disappears within a single time step. -- Cheers Michał
On Wed, Aug 4, 2021 at 4:00 PM YueCompl
wrote: Thanks Michał,
I feel less confused as I realized the non-halting possibility per bottoms, from your hint.
I too think the signaling NaN is dreadful enough, so fortunately it's rarely seen nowadays.
Actually what's on my mind was roughly something like "Maybe on steroids", I'm aware that NaN semantics breaks `Num` (or descendants) laws, as seen at https://gitlab.haskell.org/ghc/ghc/-/blob/master/libraries/base/GHC/Float.hs
Note that due to the presence of @NaN@, not all elements of 'Float' have an additive inverse.
Also note that due to the presence of -0, Float's 'Num' instance doesn't have an additive identity
Note that due to the presence of @NaN@, not all elements of 'Float' have an multiplicative inverse.
So it should have been another family of `Num` classes, within which, various NaN related semantics can be legal, amongst which I'd think:
* Silent propagation of NaN in arithmetics, like `Maybe` monad does, seems quite acceptable * Identity test, namely `NaN` /= `NaN` - this lacks theoretical ground or not? * Comparison, neither `NaN` > 1 nor `NaN` <= 1 - whether or not there's a theoretical framework for this to hold? Maybe `Boolean` type needs enhancement too to do it?
No such family of `Num` classes exists to my aware by now, I just can't help wondering why.
Cheers, Compl
On 2021-08-04, at 02:38, Michał J Gajda
wrote: Dear Yue,
Bottom has much weaker semantics than an exception: it means You may never get a result and thus will never handle it!
Another reason is convenience: it is frequently the case that giving NaN in a row of numbers is much more informative than crashing a program with an exception and never printing the result anyway.
Finally IEEE special values have clear propagation semantics: they are basically Maybe on steroids.
The problem with this approach is indeed a silent handling.
But in order to fix this, it is better to add preconditions to specific algorithms that do not allow IEEE special value on input (`isFinite` or `isNotNaN`) and then track the origin of the special value with the methods like those described here: https://skillsmatter.com/skillscasts/14905-agile-functional-data-pipeline-in...
Never throw an error without telling exactly why it happened and exactly where to fix it :-). Using bottom is last resort; exceptions likewise. -- Cheers Michał
-- Pozdrawiam Michał
-- Pozdrawiam Michał

But I'd think algebraic effects is orthogonal to Monad/Applicative/Functor, it's capable to separate effects from pure code on its own. Current standard classes in Haskell were designed without algebraic effect in mind. Especially the `Num` and its descendants, allied with `Eq` `Ord` and friends, I do see they can never allow `NaN` to be a legal existence, so there sure need another hierarchy of classes works similarly but embraces IEEE 754 at the same time. The hardware de facto has established intrinsic implementation of NaN/Inf semantics, including propagation during arithmetics and special rules during comparisons, we just need ratification in our type system, maybe retrospectively. Or `NaN` is actually another [billion-dollar mistake](https://en.wikipedia.org/wiki/Tony_Hoare#Apologies_and_retractions https://en.wikipedia.org/wiki/Tony_Hoare#Apologies_and_retractions) we'd rather to avoid? Aside from that, currently `ArithException` can only be caught within `IO` monad, but it can occur in evaluation of "pure" code. As I understand it, monad is a sublanguage to express "order" in execution (along with its bigger purpose of effect tracking), while evaluation of pure code has no "order" semantics thus in no need of monads. But pure code has nesting structures nevertheless, so to express the awareness/handling of NaN, "divide by zero" and similar situations, in a specific subsection of the pure code block, monad (i.e. IO here) based exception handling is not ideal here, as it sorta works by delimiting related pure computations into monadic steps, but that's unnatural or abuse of the execution order expressing device. Algebraic effects & handlers is the perfect device for such support, as far as I see it now, but strangely I don't feel it's absolute necessary in doing this job. The situation is still messy in my head...
On 2021-08-05, at 11:51, Michal J Gajda
wrote: Yue,
Yes, it seems it would work This useful workaround works uses exception effect. So it may have two disadvantages:
1. You may only catch the effect in a monad that can catch exceptions, like IO. 2. It does not give a clear path for handling collections of computations.
Note that DSLs also need to redefine Eq as effectful class. Then `(==) :: Applicative expr => expr a -> expr a -> expr bool`.
This solution may be preferred if You have:
* a DSL already * additional metadata attached to values, like provenance, security access level, versioning, Merkel hash, memo hash, equivalence class etc. * want to handle error values without exposing Yourself to imprecise exceptions etc.
It has disadvantage of redefining several standard classes, and we do not yet seem to have a library that would properly provide these type classes parameterized over any Applicative.
But again, the need for more principled handling of error values will likely come as software scales. — Best regards Michał
On Wed, 4 Aug 2021 at 16:56 YueCompl
mailto:compl.yue@icloud.com> wrote: `Eq` relies on the established `Bool` type, then can we solve it, if given algebraic effects & handlers, by Church-encoding an effectful Boolean type? e.g. true === \a b -> a false === \a b -> b cmpWithNaN === \a b -> perform ComparingWithNaN
Then (==) and (/=) in `Eq`, together with friends in `Ord` like (>) (<) all return `cmpWithNaN` when at least one NaN is involved.
This mechanism is open so all kinds of anomalies can be handled similarly, otherwise even we have all NaN, Inf, Underflow, Overflow etc. handled well, there must be more situations we haven't thought of.
On 2021-08-04, at 22:24, Michal J Gajda
mailto:mgajda@mimuw.edu.pl> wrote: The infamous `NaN /= NaN` makes only sense for `NaN` originating as a result, since we cannot compare `NaN`s originating from different computations. But it breaks `Eq` instance laws as needed for property tests. That is why comparison on `NaN` is better handled by `isFinite`, `isANumber` predicates. Note that beside `NaN` we also have other anomalous values, like Underflow, Overflow, +inf and -inf. These are all error values, and can hardly be treated in any other way. And they all need to be handled for floating points.
Yes, comparing `NaN` with anything should give a rise to another error value. That means that the only way out is making Either Error Float, and then `(>=) :: Either Error Float -> Either Error Float -> Either Error Bool` So basically we need to lift all `Num` operations to the `Either Error` Monad.
That is probably best way to fix the problem: once error value appears, we need to treat it consistently throughout entire computation. At the same time, we do not want a single error value to dominate entire computation, so that is why we treat collections of computations as computations that give a collection of good results and a collection of errors separately. If we take this into consideration, we notice that most interesting computations occur on collections of values, and thus yield a collection of results, not just a single output.
That is one takeaway from the referenced presentation on data analytics in Haskell. (Similar presentation was also well received on Data Science Europe. It should be on YouTube by now.)
Example of a 3D rotation is instructive: if NaN appears for any single coordinate, we can get a useful results for all other coordinates, and thus narrow impact of an error. If the next step is projection on X-Y coordinates, then NaN or Over/Under-flow within Z does not affect the result.
To my understanding, that is also the reason why IEEE mandated special treatment of error values: most of the computations happen on large matrices, vectors etc, and crashing for each single NaN would be a true disaster. It can be even ignored, when the NaN is computed for an energy component within a single frame of long-running simulation, and the error disappears within a single time step. -- Cheers Michał
On Wed, Aug 4, 2021 at 4:00 PM YueCompl
mailto:compl.yue@icloud.com> wrote: Thanks Michał,
I feel less confused as I realized the non-halting possibility per bottoms, from your hint.
I too think the signaling NaN is dreadful enough, so fortunately it's rarely seen nowadays.
Actually what's on my mind was roughly something like "Maybe on steroids", I'm aware that NaN semantics breaks `Num` (or descendants) laws, as seen at https://gitlab.haskell.org/ghc/ghc/-/blob/master/libraries/base/GHC/Float.hs https://gitlab.haskell.org/ghc/ghc/-/blob/master/libraries/base/GHC/Float.hs
Note that due to the presence of @NaN@, not all elements of 'Float' have an additive inverse.
Also note that due to the presence of -0, Float's 'Num' instance doesn't have an additive identity
Note that due to the presence of @NaN@, not all elements of 'Float' have an multiplicative inverse.
So it should have been another family of `Num` classes, within which, various NaN related semantics can be legal, amongst which I'd think:
* Silent propagation of NaN in arithmetics, like `Maybe` monad does, seems quite acceptable * Identity test, namely `NaN` /= `NaN` - this lacks theoretical ground or not? * Comparison, neither `NaN` > 1 nor `NaN` <= 1 - whether or not there's a theoretical framework for this to hold? Maybe `Boolean` type needs enhancement too to do it?
No such family of `Num` classes exists to my aware by now, I just can't help wondering why.
Cheers, Compl
On 2021-08-04, at 02:38, Michał J Gajda
mailto:mjgajda@gmail.com> wrote: Dear Yue,
Bottom has much weaker semantics than an exception: it means You may never get a result and thus will never handle it!
Another reason is convenience: it is frequently the case that giving NaN in a row of numbers is much more informative than crashing a program with an exception and never printing the result anyway.
Finally IEEE special values have clear propagation semantics: they are basically Maybe on steroids.
The problem with this approach is indeed a silent handling.
But in order to fix this, it is better to add preconditions to specific algorithms that do not allow IEEE special value on input (`isFinite` or `isNotNaN`) and then track the origin of the special value with the methods like those described here: https://skillsmatter.com/skillscasts/14905-agile-functional-data-pipeline-in... https://skillsmatter.com/skillscasts/14905-agile-functional-data-pipeline-in...
Never throw an error without telling exactly why it happened and exactly where to fix it :-). Using bottom is last resort; exceptions likewise. -- Cheers Michał
-- Pozdrawiam Michał
-- Pozdrawiam Michał

You quoted
"> Note that due to the presence of @NaN@, not all elements of 'Float'
have an additive inverse."
Let x y and z be finite floating-point numbers such that x + y ==> z.
Does there always exist neg(y) such that z + neg(y) ==> x?
NO.
And the presence or absence of NaN in the system makes no difference.
If, for example, you add 1.0e-18 to 1.0e0, the answer is 1.0e0 exactly.
That is, (x + y) - y == 0, but x is not 0.
In the presence of rounding, additive inverses do not in general exist.
Neither do multiplicative inverses.
Also addition and multiplication are not associative, but you knew that.
The only reason Float and Double are in Num is because Haskell doesn't
offer ad hoc overloading. People have been saying that the Prelude needs
refactoring for years.
The main thing that NaN wrecks that wasn't already broken is Eq. I would
argue that the right decision there would have been to rule that x == y
(when x and y are floating point numbers) precisely when x and y are
represented by the same bit pattern, with a separate operation for IEEE
"ordered and equal".
At some point, Haskell should make provision for decimal floating point,
as the current versions of IEEE 754 and C do, and that might be a good
reorganisation time.
On Thu, 5 Aug 2021 at 02:05, YueCompl via Haskell-Cafe
Thanks Michał,
I feel less confused as I realized the non-halting possibility per bottoms, from your hint.
I too think the signaling NaN is dreadful enough, so fortunately it's rarely seen nowadays.
Actually what's on my mind was roughly something like "Maybe on steroids", I'm aware that NaN semantics breaks `Num` (or descendants) laws, as seen at https://gitlab.haskell.org/ghc/ghc/-/blob/master/libraries/base/GHC/Float.hs
Note that due to the presence of @NaN@, not all elements of 'Float' have an additive inverse.
Also note that due to the presence of -0, Float's 'Num' instance doesn't have an additive identity
Note that due to the presence of @NaN@, not all elements of 'Float' have an multiplicative inverse.
So it should have been another family of `Num` classes, within which, various NaN related semantics can be legal, amongst which I'd think:
* Silent propagation of NaN in arithmetics, like `Maybe` monad does, seems quite acceptable * Identity test, namely `NaN` /= `NaN` - this lacks theoretical ground or not? * Comparison, neither `NaN` > 1 nor `NaN` <= 1 - whether or not there's a theoretical framework for this to hold? Maybe `Boolean` type needs enhancement too to do it?
No such family of `Num` classes exists to my aware by now, I just can't help wondering why.
Cheers, Compl
On 2021-08-04, at 02:38, Michał J Gajda
wrote: Dear Yue,
Bottom has much weaker semantics than an exception: it means You may never get a result and thus will never handle it!
Another reason is convenience: it is frequently the case that giving NaN in a row of numbers is much more informative than crashing a program with an exception and never printing the result anyway.
Finally IEEE special values have clear propagation semantics: they are basically Maybe on steroids.
The problem with this approach is indeed a silent handling.
But in order to fix this, it is better to add preconditions to specific algorithms that do not allow IEEE special value on input (`isFinite` or `isNotNaN`) and then track the origin of the special value with the methods like those described here: https://skillsmatter.com/skillscasts/14905-agile-functional-data-pipeline-in...
Never throw an error without telling exactly why it happened and exactly where to fix it :-). Using bottom is last resort; exceptions likewise. -- Cheers Michał
_______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.

At some point, Haskell should make provision for decimal floating point, as the current versions of IEEE 754 and C do, and that might be a good reorganisation time.
Yeah, I think this is the thing I'm anticipating, current standard classes favor lossless computation by the laws, but large portion of the computer numeric solutions are taking loss of precision for efficiency. And neural systems even right following this approach as far as it appears, I sincerely hope Haskell can embrace it to some degree.
On 2021-08-05, at 15:26, Richard O'Keefe
wrote: You quoted "> Note that due to the presence of @NaN@, not all elements of 'Float' have an additive inverse."
Let x y and z be finite floating-point numbers such that x + y ==> z. Does there always exist neg(y) such that z + neg(y) ==> x? NO.
And the presence or absence of NaN in the system makes no difference. If, for example, you add 1.0e-18 to 1.0e0, the answer is 1.0e0 exactly. That is, (x + y) - y == 0, but x is not 0.
In the presence of rounding, additive inverses do not in general exist. Neither do multiplicative inverses.
Also addition and multiplication are not associative, but you knew that. The only reason Float and Double are in Num is because Haskell doesn't offer ad hoc overloading. People have been saying that the Prelude needs refactoring for years.
The main thing that NaN wrecks that wasn't already broken is Eq. I would argue that the right decision there would have been to rule that x == y (when x and y are floating point numbers) precisely when x and y are represented by the same bit pattern, with a separate operation for IEEE "ordered and equal".
At some point, Haskell should make provision for decimal floating point, as the current versions of IEEE 754 and C do, and that might be a good reorganisation time.
On Thu, 5 Aug 2021 at 02:05, YueCompl via Haskell-Cafe
wrote: Thanks Michał,
I feel less confused as I realized the non-halting possibility per bottoms, from your hint.
I too think the signaling NaN is dreadful enough, so fortunately it's rarely seen nowadays.
Actually what's on my mind was roughly something like "Maybe on steroids", I'm aware that NaN semantics breaks `Num` (or descendants) laws, as seen at https://gitlab.haskell.org/ghc/ghc/-/blob/master/libraries/base/GHC/Float.hs
Note that due to the presence of @NaN@, not all elements of 'Float' have an additive inverse.
Also note that due to the presence of -0, Float's 'Num' instance doesn't have an additive identity
Note that due to the presence of @NaN@, not all elements of 'Float' have an multiplicative inverse.
So it should have been another family of `Num` classes, within which, various NaN related semantics can be legal, amongst which I'd think:
* Silent propagation of NaN in arithmetics, like `Maybe` monad does, seems quite acceptable * Identity test, namely `NaN` /= `NaN` - this lacks theoretical ground or not? * Comparison, neither `NaN` > 1 nor `NaN` <= 1 - whether or not there's a theoretical framework for this to hold? Maybe `Boolean` type needs enhancement too to do it?
No such family of `Num` classes exists to my aware by now, I just can't help wondering why.
Cheers, Compl
On 2021-08-04, at 02:38, Michał J Gajda
wrote: Dear Yue,
Bottom has much weaker semantics than an exception: it means You may never get a result and thus will never handle it!
Another reason is convenience: it is frequently the case that giving NaN in a row of numbers is much more informative than crashing a program with an exception and never printing the result anyway.
Finally IEEE special values have clear propagation semantics: they are basically Maybe on steroids.
The problem with this approach is indeed a silent handling.
But in order to fix this, it is better to add preconditions to specific algorithms that do not allow IEEE special value on input (`isFinite` or `isNotNaN`) and then track the origin of the special value with the methods like those described here: https://skillsmatter.com/skillscasts/14905-agile-functional-data-pipeline-in...
Never throw an error without telling exactly why it happened and exactly where to fix it :-). Using bottom is last resort; exceptions likewise. -- Cheers Michał
_______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.

So we have two things here:
* lossy computation that needs a distance (metric) between points below
epsilon instead of a comparison; in this case we should never ask for exact
equality, but rather ask if a result is within a certain radius from a
result. That means we measure convergence according to a metric, not
equivalence.
```
class Ord m => Metric m a where
dist :: a -> a -> m
a ~= b = dist a b <= epsilon
```
* handling and propagation of different error values.
That would require a rehash of both standard libraries and most
mathematical algebra libraries for Haskell.
For at least two reasons:
* libraries assume a naive equality works for all types. Holds in a world
of infinte precision and lossless operations, but never holds for
approximations.
* our propagation of universal error values is incomplete, and usually
missing from complex algorithms. In other words `Either String` Monad does
not work: we want collections of error values just like we have collections
of inputs.
Personally I will be overjoyed when our community finally gets the better
type class library for approximated types.
Would You agree to review a teaser if I post it here?
—
Cheers
Michał
On Thu, 5 Aug 2021 at 10:41 YueCompl
At some point, Haskell should make provision for decimal floating point, as the current versions of IEEE 754 and C do, and that might be a good reorganisation time.
Yeah, I think this is the thing I'm anticipating, current standard classes favor lossless computation by the laws, but large portion of the computer numeric solutions are taking loss of precision for efficiency. And neural systems even right following this approach as far as it appears, I sincerely hope Haskell can embrace it to some degree.
On 2021-08-05, at 15:26, Richard O'Keefe
wrote: You quoted "> Note that due to the presence of @NaN@, not all elements of 'Float' have an additive inverse."
Let x y and z be finite floating-point numbers such that x + y ==> z. Does there always exist neg(y) such that z + neg(y) ==> x? NO.
And the presence or absence of NaN in the system makes no difference. If, for example, you add 1.0e-18 to 1.0e0, the answer is 1.0e0 exactly. That is, (x + y) - y == 0, but x is not 0.
In the presence of rounding, additive inverses do not in general exist. Neither do multiplicative inverses.
Also addition and multiplication are not associative, but you knew that. The only reason Float and Double are in Num is because Haskell doesn't offer ad hoc overloading. People have been saying that the Prelude needs refactoring for years.
The main thing that NaN wrecks that wasn't already broken is Eq. I would argue that the right decision there would have been to rule that x == y (when x and y are floating point numbers) precisely when x and y are represented by the same bit pattern, with a separate operation for IEEE "ordered and equal".
At some point, Haskell should make provision for decimal floating point, as the current versions of IEEE 754 and C do, and that might be a good reorganisation time.
On Thu, 5 Aug 2021 at 02:05, YueCompl via Haskell-Cafe
wrote: Thanks Michał,
I feel less confused as I realized the non-halting possibility per
bottoms, from your hint.
I too think the signaling NaN is dreadful enough, so fortunately it's
rarely seen nowadays.
Actually what's on my mind was roughly something like "Maybe on
steroids", I'm aware that NaN semantics breaks `Num` (or descendants) laws, as seen at https://gitlab.haskell.org/ghc/ghc/-/blob/master/libraries/base/GHC/Float.hs
Note that due to the presence of @NaN@, not all elements of 'Float'
have an additive inverse.
Also note that due to the presence of -0, Float's 'Num' instance
doesn't have an additive identity
Note that due to the presence of @NaN@, not all elements of 'Float'
have an multiplicative inverse.
So it should have been another family of `Num` classes, within which,
various NaN related semantics can be legal, amongst which I'd think:
* Silent propagation of NaN in arithmetics, like `Maybe` monad does,
* Identity test, namely `NaN` /= `NaN` - this lacks theoretical ground or not? * Comparison, neither `NaN` > 1 nor `NaN` <= 1 - whether or not there's a theoretical framework for this to hold? Maybe `Boolean` type needs enhancement too to do it?
No such family of `Num` classes exists to my aware by now, I just can't help wondering why.
Cheers, Compl
On 2021-08-04, at 02:38, Michał J Gajda
wrote: Dear Yue,
Bottom has much weaker semantics than an exception: it means You may never get a result and thus will never handle it!
Another reason is convenience: it is frequently the case that giving NaN in a row of numbers is much more informative than crashing a program with an exception and never printing the result anyway.
Finally IEEE special values have clear propagation semantics: they are basically Maybe on steroids.
The problem with this approach is indeed a silent handling.
But in order to fix this, it is better to add preconditions to specific algorithms that do not allow IEEE special value on input (`isFinite` or `isNotNaN`) and then track the origin of the special value with the methods
seems quite acceptable like those described here: https://skillsmatter.com/skillscasts/14905-agile-functional-data-pipeline-in...
Never throw an error without telling exactly why it happened and
exactly where to fix it :-). Using bottom is last resort; exceptions likewise.
-- Cheers Michał
_______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.
-- Pozdrawiam Michał

Dear Michał, I suppose by "You" you mean more people in this list those are more capable and have greater wisdom in this topic, I don't think myself a qualified Haskeller yet, but I can't help thinking about it. I especially wonder at this moment, if more proper & prevalent handling of metric errors can lead to new discoveries in neural programming (more principled training of neural networks? synthetic samples & labels beyond mere data acquisition?) I have strong feel that Haskell shall really shine in modeling or trialing related ideas, compared to other languages and tools. Can't speak for others but I quite anticipate your teaser, even though I may not fully understand it with my limited expertise in this area. Best regards, Compl
On 2021-08-09, at 18:18, Michal J Gajda
wrote: So we have two things here:
* lossy computation that needs a distance (metric) between points below epsilon instead of a comparison; in this case we should never ask for exact equality, but rather ask if a result is within a certain radius from a result. That means we measure convergence according to a metric, not equivalence.
``` class Ord m => Metric m a where dist :: a -> a -> m
a ~= b = dist a b <= epsilon ```
* handling and propagation of different error values.
That would require a rehash of both standard libraries and most mathematical algebra libraries for Haskell.
For at least two reasons:
* libraries assume a naive equality works for all types. Holds in a world of infinte precision and lossless operations, but never holds for approximations.
* our propagation of universal error values is incomplete, and usually missing from complex algorithms. In other words `Either String` Monad does not work: we want collections of error values just like we have collections of inputs.
Personally I will be overjoyed when our community finally gets the better type class library for approximated types.
Would You agree to review a teaser if I post it here? — Cheers Michał
On Thu, 5 Aug 2021 at 10:41 YueCompl
mailto:compl.yue@icloud.com> wrote: At some point, Haskell should make provision for decimal floating point, as the current versions of IEEE 754 and C do, and that might be a good reorganisation time.
Yeah, I think this is the thing I'm anticipating, current standard classes favor lossless computation by the laws, but large portion of the computer numeric solutions are taking loss of precision for efficiency. And neural systems even right following this approach as far as it appears, I sincerely hope Haskell can embrace it to some degree.
On 2021-08-05, at 15:26, Richard O'Keefe
mailto:raoknz@gmail.com> wrote: You quoted "> Note that due to the presence of @NaN@, not all elements of 'Float' have an additive inverse."
Let x y and z be finite floating-point numbers such that x + y ==> z. Does there always exist neg(y) such that z + neg(y) ==> x? NO.
And the presence or absence of NaN in the system makes no difference. If, for example, you add 1.0e-18 to 1.0e0, the answer is 1.0e0 exactly. That is, (x + y) - y == 0, but x is not 0.
In the presence of rounding, additive inverses do not in general exist. Neither do multiplicative inverses.
Also addition and multiplication are not associative, but you knew that. The only reason Float and Double are in Num is because Haskell doesn't offer ad hoc overloading. People have been saying that the Prelude needs refactoring for years.
The main thing that NaN wrecks that wasn't already broken is Eq. I would argue that the right decision there would have been to rule that x == y (when x and y are floating point numbers) precisely when x and y are represented by the same bit pattern, with a separate operation for IEEE "ordered and equal".
At some point, Haskell should make provision for decimal floating point, as the current versions of IEEE 754 and C do, and that might be a good reorganisation time.
On Thu, 5 Aug 2021 at 02:05, YueCompl via Haskell-Cafe
mailto:haskell-cafe@haskell.org> wrote: Thanks Michał,
I feel less confused as I realized the non-halting possibility per bottoms, from your hint.
I too think the signaling NaN is dreadful enough, so fortunately it's rarely seen nowadays.
Actually what's on my mind was roughly something like "Maybe on steroids", I'm aware that NaN semantics breaks `Num` (or descendants) laws, as seen at https://gitlab.haskell.org/ghc/ghc/-/blob/master/libraries/base/GHC/Float.hs https://gitlab.haskell.org/ghc/ghc/-/blob/master/libraries/base/GHC/Float.hs
Note that due to the presence of @NaN@, not all elements of 'Float' have an additive inverse.
Also note that due to the presence of -0, Float's 'Num' instance doesn't have an additive identity
Note that due to the presence of @NaN@, not all elements of 'Float' have an multiplicative inverse.
So it should have been another family of `Num` classes, within which, various NaN related semantics can be legal, amongst which I'd think:
* Silent propagation of NaN in arithmetics, like `Maybe` monad does, seems quite acceptable * Identity test, namely `NaN` /= `NaN` - this lacks theoretical ground or not? * Comparison, neither `NaN` > 1 nor `NaN` <= 1 - whether or not there's a theoretical framework for this to hold? Maybe `Boolean` type needs enhancement too to do it?
No such family of `Num` classes exists to my aware by now, I just can't help wondering why.
Cheers, Compl
On 2021-08-04, at 02:38, Michał J Gajda
mailto:mjgajda@gmail.com> wrote: Dear Yue,
Bottom has much weaker semantics than an exception: it means You may never get a result and thus will never handle it!
Another reason is convenience: it is frequently the case that giving NaN in a row of numbers is much more informative than crashing a program with an exception and never printing the result anyway.
Finally IEEE special values have clear propagation semantics: they are basically Maybe on steroids.
The problem with this approach is indeed a silent handling.
But in order to fix this, it is better to add preconditions to specific algorithms that do not allow IEEE special value on input (`isFinite` or `isNotNaN`) and then track the origin of the special value with the methods like those described here: https://skillsmatter.com/skillscasts/14905-agile-functional-data-pipeline-in... https://skillsmatter.com/skillscasts/14905-agile-functional-data-pipeline-in...
Never throw an error without telling exactly why it happened and exactly where to fix it :-). Using bottom is last resort; exceptions likewise. -- Cheers Michał
_______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.
-- Pozdrawiam Michał

Well said.
I do think signalling nans as a runtime flag option that converts them into
exceptions is still a pretty viable option. The right hooks in the rts are
there !
On Thu, Aug 5, 2021 at 12:28 AM Richard O'Keefe
You quoted "> Note that due to the presence of @NaN@, not all elements of 'Float' have an additive inverse."
Let x y and z be finite floating-point numbers such that x + y ==> z. Does there always exist neg(y) such that z + neg(y) ==> x? NO.
And the presence or absence of NaN in the system makes no difference. If, for example, you add 1.0e-18 to 1.0e0, the answer is 1.0e0 exactly. That is, (x + y) - y == 0, but x is not 0.
In the presence of rounding, additive inverses do not in general exist. Neither do multiplicative inverses.
Also addition and multiplication are not associative, but you knew that. The only reason Float and Double are in Num is because Haskell doesn't offer ad hoc overloading. People have been saying that the Prelude needs refactoring for years.
The main thing that NaN wrecks that wasn't already broken is Eq. I would argue that the right decision there would have been to rule that x == y (when x and y are floating point numbers) precisely when x and y are represented by the same bit pattern, with a separate operation for IEEE "ordered and equal".
At some point, Haskell should make provision for decimal floating point, as the current versions of IEEE 754 and C do, and that might be a good reorganisation time.
On Thu, 5 Aug 2021 at 02:05, YueCompl via Haskell-Cafe
wrote: Thanks Michał,
I feel less confused as I realized the non-halting possibility per
bottoms, from your hint.
I too think the signaling NaN is dreadful enough, so fortunately it's
rarely seen nowadays.
Actually what's on my mind was roughly something like "Maybe on
steroids", I'm aware that NaN semantics breaks `Num` (or descendants) laws, as seen at https://gitlab.haskell.org/ghc/ghc/-/blob/master/libraries/base/GHC/Float.hs
Note that due to the presence of @NaN@, not all elements of 'Float'
have an additive inverse.
Also note that due to the presence of -0, Float's 'Num' instance
doesn't have an additive identity
Note that due to the presence of @NaN@, not all elements of 'Float'
have an multiplicative inverse.
So it should have been another family of `Num` classes, within which,
various NaN related semantics can be legal, amongst which I'd think:
* Silent propagation of NaN in arithmetics, like `Maybe` monad does,
* Identity test, namely `NaN` /= `NaN` - this lacks theoretical ground or not? * Comparison, neither `NaN` > 1 nor `NaN` <= 1 - whether or not there's a theoretical framework for this to hold? Maybe `Boolean` type needs enhancement too to do it?
No such family of `Num` classes exists to my aware by now, I just can't help wondering why.
Cheers, Compl
On 2021-08-04, at 02:38, Michał J Gajda
wrote: Dear Yue,
Bottom has much weaker semantics than an exception: it means You may never get a result and thus will never handle it!
Another reason is convenience: it is frequently the case that giving NaN in a row of numbers is much more informative than crashing a program with an exception and never printing the result anyway.
Finally IEEE special values have clear propagation semantics: they are basically Maybe on steroids.
The problem with this approach is indeed a silent handling.
But in order to fix this, it is better to add preconditions to specific algorithms that do not allow IEEE special value on input (`isFinite` or `isNotNaN`) and then track the origin of the special value with the methods
seems quite acceptable like those described here: https://skillsmatter.com/skillscasts/14905-agile-functional-data-pipeline-in...
Never throw an error without telling exactly why it happened and exactly
where to fix it :-). Using bottom is last resort; exceptions likewise.
-- Cheers Michał
_______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.
Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.

It would be very kind if You contributed an example code for these. I do not think anybody else in the discussion knows RTS as well as You. Cheers M czw., 12 sie 2021, 16:59 użytkownik Carter Schonwald < carter.schonwald@gmail.com> napisał:
Well said.
I do think signalling nans as a runtime flag option that converts them into exceptions is still a pretty viable option. The right hooks in the rts are there !
On Thu, Aug 5, 2021 at 12:28 AM Richard O'Keefe
wrote: You quoted "> Note that due to the presence of @NaN@, not all elements of 'Float' have an additive inverse."
Let x y and z be finite floating-point numbers such that x + y ==> z. Does there always exist neg(y) such that z + neg(y) ==> x? NO.
And the presence or absence of NaN in the system makes no difference. If, for example, you add 1.0e-18 to 1.0e0, the answer is 1.0e0 exactly. That is, (x + y) - y == 0, but x is not 0.
In the presence of rounding, additive inverses do not in general exist. Neither do multiplicative inverses.
Also addition and multiplication are not associative, but you knew that. The only reason Float and Double are in Num is because Haskell doesn't offer ad hoc overloading. People have been saying that the Prelude needs refactoring for years.
The main thing that NaN wrecks that wasn't already broken is Eq. I would argue that the right decision there would have been to rule that x == y (when x and y are floating point numbers) precisely when x and y are represented by the same bit pattern, with a separate operation for IEEE "ordered and equal".
At some point, Haskell should make provision for decimal floating point, as the current versions of IEEE 754 and C do, and that might be a good reorganisation time.
On Thu, 5 Aug 2021 at 02:05, YueCompl via Haskell-Cafe
wrote: Thanks Michał,
I feel less confused as I realized the non-halting possibility per
bottoms, from your hint.
I too think the signaling NaN is dreadful enough, so fortunately it's
rarely seen nowadays.
Actually what's on my mind was roughly something like "Maybe on
steroids", I'm aware that NaN semantics breaks `Num` (or descendants) laws, as seen at https://gitlab.haskell.org/ghc/ghc/-/blob/master/libraries/base/GHC/Float.hs
Note that due to the presence of @NaN@, not all elements of 'Float'
have an additive inverse.
Also note that due to the presence of -0, Float's 'Num' instance
doesn't have an additive identity
Note that due to the presence of @NaN@, not all elements of 'Float'
have an multiplicative inverse.
So it should have been another family of `Num` classes, within which,
various NaN related semantics can be legal, amongst which I'd think:
* Silent propagation of NaN in arithmetics, like `Maybe` monad does,
* Identity test, namely `NaN` /= `NaN` - this lacks theoretical ground or not? * Comparison, neither `NaN` > 1 nor `NaN` <= 1 - whether or not there's a theoretical framework for this to hold? Maybe `Boolean` type needs enhancement too to do it?
No such family of `Num` classes exists to my aware by now, I just can't help wondering why.
Cheers, Compl
On 2021-08-04, at 02:38, Michał J Gajda
wrote: Dear Yue,
Bottom has much weaker semantics than an exception: it means You may never get a result and thus will never handle it!
Another reason is convenience: it is frequently the case that giving NaN in a row of numbers is much more informative than crashing a program with an exception and never printing the result anyway.
Finally IEEE special values have clear propagation semantics: they are basically Maybe on steroids.
The problem with this approach is indeed a silent handling.
But in order to fix this, it is better to add preconditions to specific algorithms that do not allow IEEE special value on input (`isFinite` or `isNotNaN`) and then track the origin of the special value with the methods
seems quite acceptable like those described here: https://skillsmatter.com/skillscasts/14905-agile-functional-data-pipeline-in...
Never throw an error without telling exactly why it happened and
exactly where to fix it :-). Using bottom is last resort; exceptions likewise.
-- Cheers Michał
_______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.
Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.
participants (4)
-
Carter Schonwald
-
Michal J Gajda
-
Richard O'Keefe
-
YueCompl