mirror of
https://github.com/digital-asset/daml.git
synced 2024-09-21 01:37:15 +03:00
edff8a416d
* Move files in daml-foundations/daml-ghc to compiler/damlc There is also a bit of refactoring going on to actually split things apart into sensible targets. What is still missing is a cleanup of the module hierarchy and a cleanup of the test targets but I’ll leave those for separate PRs. As a nice bonus, this also reduces dependencies between targets so it will speed up compiles. * Update .hie-bios
355 lines
13 KiB
Haskell
355 lines
13 KiB
Haskell
-- Copyright (c) 2019 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
|
|
-- SPDX-License-Identifier: Apache-2.0
|
|
|
|
-- Copied from https://github.com/ghc/ghc/blob/23f6f31dd66d7c370cb8beec3f1d96a0cb577393/libraries/ghc-prim/GHC/Classes.hs
|
|
-- All DA specific modifications are marked with [DA]
|
|
|
|
{-# LANGUAGE DamlSyntax #-} -- [DA]
|
|
|
|
-- [DA] {-# LANGUAGE CPP #-}
|
|
{-# LANGUAGE Trustworthy #-}
|
|
{-# LANGUAGE NoImplicitPrelude, MagicHash, StandaloneDeriving, BangPatterns,
|
|
KindSignatures, DataKinds, ConstraintKinds,
|
|
MultiParamTypeClasses, FunctionalDependencies #-}
|
|
{-# LANGUAGE AllowAmbiguousTypes #-}
|
|
-- ip :: IP x a => a is strictly speaking ambiguous, but IP is magic
|
|
{-# LANGUAGE UndecidableSuperClasses #-}
|
|
-- Because of the type-variable superclasses for tuples
|
|
|
|
{-# OPTIONS_GHC -Wno-unused-imports #-}
|
|
-- -Wno-unused-imports needed for the GHC.Tuple import below. Sigh.
|
|
|
|
{-# OPTIONS_GHC -Wno-unused-top-binds #-}
|
|
-- -Wno-unused-top-binds is there (I hope) to stop Haddock complaining
|
|
-- about the constraint tuples being defined but not used
|
|
|
|
{-# OPTIONS_HADDOCK hide #-}
|
|
daml 1.2
|
|
-- | HIDE
|
|
|
|
--------------------------------------------------------------------------------
|
|
--
|
|
-- Module : GHC.Classes
|
|
-- Copyright : (c) The University of Glasgow, 1992-2002
|
|
-- License : see libraries/base/LICENSE
|
|
--
|
|
-- Maintainer : cvs-ghc@haskell.org
|
|
-- Stability : internal
|
|
-- Portability : non-portable (GHC extensions)
|
|
--
|
|
-- Basic classes.
|
|
--
|
|
--------------------------------------------------------------------------------
|
|
|
|
module GHC.Classes(
|
|
-- * Implicit paramaters
|
|
IP(..),
|
|
|
|
-- * Equality and ordering
|
|
Eq(..),
|
|
Ord(..),
|
|
|
|
-- * Functions over Bool
|
|
(&&), (||), not,
|
|
) where
|
|
|
|
import GHC.Base
|
|
import GHC.Prim
|
|
import GHC.Tuple
|
|
import GHC.CString (unpackCString#)
|
|
import GHC.Types
|
|
import DA.Types
|
|
|
|
infix 4 ==, /=, <, <=, >=, >
|
|
infixr 3 &&
|
|
infixr 2 ||
|
|
|
|
default () -- Double isn't available yet
|
|
|
|
-- | The syntax `?x :: a` is desugared into `IP "x" a`
|
|
-- IP is declared very early, so that libraries can take
|
|
-- advantage of the implicit-call-stack feature
|
|
class IP (x : Symbol) a | x -> a where
|
|
ip : a
|
|
|
|
{- $matching_overloaded_methods_in_rules
|
|
|
|
Matching on class methods (e.g. `(==)`) in rewrite rules tends to be a bit
|
|
fragile. For instance, consider this motivating example from the `bytestring`
|
|
library,
|
|
|
|
> break :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
|
|
> breakByte :: Word8 -> ByteString -> (ByteString, ByteString)
|
|
> {-# RULES "break -> breakByte" forall a. break (== x) = breakByte x #-}
|
|
|
|
Here we have two functions, with `breakByte` providing an optimized
|
|
implementation of `break` where the predicate is merely testing for equality
|
|
with a known `Word8`. As written, however, this rule will be quite fragile as
|
|
the `(==)` class operation rule may rewrite the predicate before our `break`
|
|
rule has a chance to fire.
|
|
|
|
For this reason, most of the primitive types in `base` have 'Eq' and 'Ord'
|
|
instances defined in terms of helper functions with inlinings delayed to phase
|
|
1. For instance, `Word8`\'s `Eq` instance looks like,
|
|
|
|
> instance Eq Word8 where
|
|
> (==) = eqWord8
|
|
> (/=) = neWord8
|
|
>
|
|
> eqWord8, neWord8 :: Word8 -> Word8 -> Bool
|
|
> eqWord8 (W8# x) (W8# y) = ...
|
|
> neWord8 (W8# x) (W8# y) = ...
|
|
> {-# INLINE [1] eqWord8 #-}
|
|
> {-# INLINE [1] neWord8 #-}
|
|
|
|
This allows us to save our `break` rule above by rewriting it to instead match
|
|
against `eqWord8`,
|
|
|
|
> {-# RULES "break -> breakByte" forall a. break (`eqWord8` x) = breakByte x #-}
|
|
|
|
Currently this is only done for '(==)', '(/=)', '(<)', '(<=)', '(>)', and '(>=)'
|
|
for the types in "GHC.Word" and "GHC.Int".
|
|
-}
|
|
|
|
-- | The `Eq` class defines equality (`==`) and inequality (`/=`).
|
|
-- All the basic datatypes exported by the "Prelude" are instances of `Eq`,
|
|
-- and `Eq` may be derived for any datatype whose constituents are also
|
|
-- instances of `Eq`.
|
|
--
|
|
-- Usually, `==` is expected to implement an equivalence relationship where two
|
|
-- values comparing equal are indistinguishable by "public" functions, with
|
|
-- a "public" function being one not allowing to see implementation details. For
|
|
-- example, for a type representing non-normalised natural numbers modulo 100,
|
|
-- a "public" function doesn't make the difference between 1 and 201. It is
|
|
-- expected to have the following properties:
|
|
--
|
|
-- **Reflexivity**: `x == x` = `True`
|
|
--
|
|
-- **Symmetry**: `x == y` = `y == x`
|
|
--
|
|
-- **Transitivity**: if `x == y && y == z` = `True`, then `x == z` = `True`
|
|
--
|
|
-- **Substitutivity**: if `x == y` = `True` and `f` is a "public" function
|
|
-- whose return type is an instance of `Eq`, then `f x == f y` = `True`
|
|
--
|
|
-- **Negation**: `x /= y` = `not (x == y)`
|
|
--
|
|
-- Minimal complete definition: either `==` or `/=`.
|
|
--
|
|
class Eq a where
|
|
(==), (/=) : a -> a -> Bool
|
|
|
|
x /= y = not (x == y)
|
|
x == y = not (x /= y)
|
|
{-# MINIMAL (==) | (/=) #-}
|
|
|
|
deriving instance Eq ()
|
|
deriving instance (Eq a, Eq b) => Eq (a, b)
|
|
deriving instance (Eq a, Eq b, Eq c) => Eq (a, b, c)
|
|
deriving instance (Eq a, Eq b, Eq c, Eq d) => Eq (a, b, c, d)
|
|
deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e) => Eq (a, b, c, d, e)
|
|
deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f)
|
|
=> Eq (a, b, c, d, e, f)
|
|
deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g)
|
|
=> Eq (a, b, c, d, e, f, g)
|
|
deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,
|
|
Eq h)
|
|
=> Eq (a, b, c, d, e, f, g, h)
|
|
deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,
|
|
Eq h, Eq i)
|
|
=> Eq (a, b, c, d, e, f, g, h, i)
|
|
deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,
|
|
Eq h, Eq i, Eq j)
|
|
=> Eq (a, b, c, d, e, f, g, h, i, j)
|
|
deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,
|
|
Eq h, Eq i, Eq j, Eq k)
|
|
=> Eq (a, b, c, d, e, f, g, h, i, j, k)
|
|
deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,
|
|
Eq h, Eq i, Eq j, Eq k, Eq l)
|
|
=> Eq (a, b, c, d, e, f, g, h, i, j, k, l)
|
|
deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,
|
|
Eq h, Eq i, Eq j, Eq k, Eq l, Eq m)
|
|
=> Eq (a, b, c, d, e, f, g, h, i, j, k, l, m)
|
|
deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,
|
|
Eq h, Eq i, Eq j, Eq k, Eq l, Eq m, Eq n)
|
|
=> Eq (a, b, c, d, e, f, g, h, i, j, k, l, m, n)
|
|
deriving instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g,
|
|
Eq h, Eq i, Eq j, Eq k, Eq l, Eq m, Eq n, Eq o)
|
|
=> Eq (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
|
|
|
|
deriving instance (Eq a, Eq b) => Eq (Either a b)
|
|
|
|
-- slightly strange encoding to avoid value level recursion
|
|
-- and to optimise so we avoid going through the dictionary lots of times
|
|
eqList : (a -> a -> Bool) -> [a] -> [a] -> Bool
|
|
eqList = primitive @"BEEqualList"
|
|
|
|
instance (Eq a) => Eq [a] where
|
|
(==) = eqList (==)
|
|
|
|
deriving instance Eq Ordering
|
|
|
|
instance Eq Bool where
|
|
(==) = primitive @"BEEqual"
|
|
|
|
instance Eq Int where
|
|
(==) = primitive @"BEEqual"
|
|
|
|
instance Eq Decimal where
|
|
(==) = primitive @"BEEqual"
|
|
|
|
instance Eq Text where
|
|
(==) = primitive @"BEEqual"
|
|
|
|
-- | The `Ord` class is used for totally ordered datatypes.
|
|
--
|
|
-- Instances of `Ord` can be derived for any user-defined datatype whose
|
|
-- constituent types are in `Ord`. The declared order of the constructors in
|
|
-- the data declaration determines the ordering in derived `Ord` instances. The
|
|
-- `Ordering` datatype allows a single comparison to determine the precise
|
|
-- ordering of two objects.
|
|
--
|
|
-- The Haskell Report defines no laws for `Ord`. However, `<=` is customarily
|
|
-- expected to implement a non-strict partial order and have the following
|
|
-- properties:
|
|
--
|
|
-- **Transitivity**: if `x <= y && y <= z` = `True`, then `x <= z` = `True`
|
|
--
|
|
-- **Reflexivity**: `x <= x` = `True`
|
|
--
|
|
-- **Antisymmetry**: if `x <= y && y <= x` = `True`, then `x == y` = `True`
|
|
--
|
|
-- Note that the following operator interactions are expected to hold:
|
|
--
|
|
-- 1. `x >= y` = `y <= x`
|
|
-- 2. `x < y` = `x <= y && x /= y`
|
|
-- 3. `x > y` = `y < x`
|
|
-- 4. `x < y` = `compare x y == LT`
|
|
-- 5. `x > y` = `compare x y == GT`
|
|
-- 6. `x == y` = `compare x y == EQ`
|
|
-- 7. `min x y == if x <= y then x else y` = 'True'
|
|
-- 8. `max x y == if x >= y then x else y` = 'True'
|
|
--
|
|
-- Minimal complete definition: either `compare` or `<=`.
|
|
-- Using `compare` can be more efficient for complex types.
|
|
--
|
|
class (Eq a) => Ord a where
|
|
compare : a -> a -> Ordering
|
|
(<), (<=), (>), (>=) : a -> a -> Bool
|
|
max, min : a -> a -> a
|
|
|
|
compare x y = if x == y then EQ
|
|
-- NB: must be '<=' not '<' to validate the
|
|
-- above claim about the minimal things that
|
|
-- can be defined for an instance of Ord:
|
|
else if x <= y then LT
|
|
else GT
|
|
|
|
x < y = case compare x y of { LT -> True; _ -> False }
|
|
x <= y = case compare x y of { GT -> False; _ -> True }
|
|
x > y = case compare x y of { GT -> True; _ -> False }
|
|
x >= y = case compare x y of { LT -> False; _ -> True }
|
|
|
|
-- These two default methods use '<=' rather than 'compare'
|
|
-- because the latter is often more expensive
|
|
max x y = if x <= y then y else x
|
|
min x y = if x <= y then x else y
|
|
{-# MINIMAL compare | (<=) #-}
|
|
|
|
deriving instance Ord ()
|
|
deriving instance (Ord a, Ord b) => Ord (a, b)
|
|
deriving instance (Ord a, Ord b, Ord c) => Ord (a, b, c)
|
|
deriving instance (Ord a, Ord b, Ord c, Ord d) => Ord (a, b, c, d)
|
|
deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e) => Ord (a, b, c, d, e)
|
|
deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f)
|
|
=> Ord (a, b, c, d, e, f)
|
|
deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g)
|
|
=> Ord (a, b, c, d, e, f, g)
|
|
deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,
|
|
Ord h)
|
|
=> Ord (a, b, c, d, e, f, g, h)
|
|
deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,
|
|
Ord h, Ord i)
|
|
=> Ord (a, b, c, d, e, f, g, h, i)
|
|
deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,
|
|
Ord h, Ord i, Ord j)
|
|
=> Ord (a, b, c, d, e, f, g, h, i, j)
|
|
deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,
|
|
Ord h, Ord i, Ord j, Ord k)
|
|
=> Ord (a, b, c, d, e, f, g, h, i, j, k)
|
|
deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,
|
|
Ord h, Ord i, Ord j, Ord k, Ord l)
|
|
=> Ord (a, b, c, d, e, f, g, h, i, j, k, l)
|
|
deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,
|
|
Ord h, Ord i, Ord j, Ord k, Ord l, Ord m)
|
|
=> Ord (a, b, c, d, e, f, g, h, i, j, k, l, m)
|
|
deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,
|
|
Ord h, Ord i, Ord j, Ord k, Ord l, Ord m, Ord n)
|
|
=> Ord (a, b, c, d, e, f, g, h, i, j, k, l, m, n)
|
|
deriving instance (Ord a, Ord b, Ord c, Ord d, Ord e, Ord f, Ord g,
|
|
Ord h, Ord i, Ord j, Ord k, Ord l, Ord m, Ord n, Ord o)
|
|
=> Ord (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
|
|
|
|
deriving instance (Ord a, Ord b) => Ord (Either a b)
|
|
|
|
instance (Ord a) => Ord [a] where
|
|
compare [] [] = EQ
|
|
compare [] (_ :: _) = LT
|
|
compare (_ :: _) [] = GT
|
|
compare (x :: xs) (y :: ys) = case compare x y of
|
|
EQ -> compare xs ys
|
|
other -> other
|
|
|
|
deriving instance Ord Ordering
|
|
|
|
instance Ord Bool where
|
|
b1 `compare` b2 = case (b1, b2) of
|
|
(False, False) -> EQ
|
|
(False, True ) -> LT
|
|
(True , False) -> GT
|
|
(True , True ) -> EQ
|
|
|
|
instance Ord Int where
|
|
(<) = primitive @"BELess"
|
|
(<=) = primitive @"BELessEq"
|
|
(>=) = primitive @"BEGreaterEq"
|
|
(>) = primitive @"BEGreater"
|
|
|
|
instance Ord Decimal where
|
|
(<) = primitive @"BELess"
|
|
(<=) = primitive @"BELessEq"
|
|
(>=) = primitive @"BEGreaterEq"
|
|
(>) = primitive @"BEGreater"
|
|
|
|
instance Ord Text where
|
|
(<) = primitive @"BELess"
|
|
(<=) = primitive @"BELessEq"
|
|
(>=) = primitive @"BEGreaterEq"
|
|
(>) = primitive @"BEGreater"
|
|
|
|
-- TODO(MH): Move this to GHC.Base and force inlining.
|
|
-- OK, so they're technically not part of a class...:
|
|
|
|
-- Boolean functions
|
|
|
|
-- | Boolean \"and\".
|
|
-- This function has short-circuiting semantics, i.e., when both arguments are
|
|
-- present and the first arguments evaluates to 'False', the second argument
|
|
-- is not evaluated at all.
|
|
(&&) : Bool -> Bool -> Bool
|
|
True && x = x
|
|
False && _ = False
|
|
|
|
-- | Boolean \"or\".
|
|
-- This function has short-circuiting semantics, i.e., when both arguments are
|
|
-- present and the first arguments evaluates to 'True', the second argument
|
|
-- is not evaluated at all.
|
|
(||) : Bool -> Bool -> Bool
|
|
True || _ = True
|
|
False || x = x
|
|
|
|
-- | Boolean \"not\"
|
|
not : Bool -> Bool
|
|
not True = False
|
|
not False = True
|