{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures             #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE PolyKinds                  #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeOperators              #-}

{-# OPTIONS_GHC -Wall #-}

-- TODO: Complex Numbers

module Language.Fortran.Model.Op.Core.Match where

import           Control.Monad                       ((>=>))
import           Data.Typeable

import           Control.Lens

import           Data.Singletons
import           Data.Singletons.Prelude.List

import           Data.Vinyl                          hiding ((:~:), Field)

import           Language.Fortran.Model.Op.Core.Core
import           Language.Fortran.Model.Singletons
import           Language.Fortran.Model.Types
import           Language.Fortran.Model.Types.Match
import           Language.Fortran.Model.Util


data MatchNumType a where
  MatchNumType :: Sing p -> Sing k -> NumericBasicType k -> Prim p k a -> MatchNumType (PrimS a)

-- | Checks if the given type is numeric, and if so returns a proof of that
-- fact.
matchNumType :: D a -> Maybe (MatchNumType a)
matchNumType :: D a -> Maybe (MatchNumType a)
matchNumType = D a -> Maybe (MatchPrimD a)
forall a. D a -> Maybe (MatchPrimD a)
matchPrimD (D a -> Maybe (MatchPrimD a))
-> (MatchPrimD a -> Maybe (MatchNumType a))
-> D a
-> Maybe (MatchNumType a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \case
  MatchPrimD (MatchPrim Sing p
sp Sing k
SBTInt) Prim p k a
p -> MatchNumType (PrimS a) -> Maybe (MatchNumType (PrimS a))
forall a. a -> Maybe a
Just (Sing p
-> Sing 'BTInt
-> NumericBasicType 'BTInt
-> Prim p 'BTInt a
-> MatchNumType (PrimS a)
forall (p2 :: Precision) (b :: BasicType) c.
Sing p2
-> Sing b
-> NumericBasicType b
-> Prim p2 b c
-> MatchNumType (PrimS c)
MatchNumType Sing p
sp Sing 'BTInt
SBasicType 'BTInt
SBTInt NumericBasicType 'BTInt
NBTInt Prim p k a
Prim p 'BTInt a
p)
  MatchPrimD (MatchPrim Sing p
sp Sing k
SBTReal) Prim p k a
p -> MatchNumType (PrimS a) -> Maybe (MatchNumType (PrimS a))
forall a. a -> Maybe a
Just (Sing p
-> Sing 'BTReal
-> NumericBasicType 'BTReal
-> Prim p 'BTReal a
-> MatchNumType (PrimS a)
forall (p2 :: Precision) (b :: BasicType) c.
Sing p2
-> Sing b
-> NumericBasicType b
-> Prim p2 b c
-> MatchNumType (PrimS c)
MatchNumType Sing p
sp Sing 'BTReal
SBasicType 'BTReal
SBTReal NumericBasicType 'BTReal
NBTReal Prim p k a
Prim p 'BTReal a
p)
  MatchPrimD a
_ -> Maybe (MatchNumType a)
forall a. Maybe a
Nothing


data MatchNumR a b where
  MatchNumR
    :: NumericBasicType k1 -> NumericBasicType k2
    -> Prim p1 k1 a -> Prim p2 k2 b
    -> Prim (PrecMax p1 p2) (BasicTypeMax k1 k2) c
    -> MatchNumR (PrimS a) (PrimS b)

-- | Checks if it is possible to perform a binary numeric operation on arguments
-- with the given respective types. If so, returns the type that would result
-- plus some more information about the types.
matchNumR :: D a -> D b -> Maybe (MatchNumR a b)
matchNumR :: D a -> D b -> Maybe (MatchNumR a b)
matchNumR = (D a -> Maybe (MatchNumType a))
-> (D b -> Maybe (MatchNumType b))
-> ((MatchNumType a, MatchNumType b) -> Maybe (MatchNumR a b))
-> D a
-> D b
-> Maybe (MatchNumR a b)
forall (m :: * -> *) a a' b b' r.
Monad m =>
(a -> m a') -> (b -> m b') -> ((a', b') -> m r) -> a -> b -> m r
matchingWith2 D a -> Maybe (MatchNumType a)
forall a. D a -> Maybe (MatchNumType a)
matchNumType D b -> Maybe (MatchNumType b)
forall a. D a -> Maybe (MatchNumType a)
matchNumType (((MatchNumType a, MatchNumType b) -> Maybe (MatchNumR a b))
 -> D a -> D b -> Maybe (MatchNumR a b))
-> ((MatchNumType a, MatchNumType b) -> Maybe (MatchNumR a b))
-> D a
-> D b
-> Maybe (MatchNumR a b)
forall a b. (a -> b) -> a -> b
$ \case
  (MatchNumType Sing p
sp1 Sing k
sk1 NumericBasicType k
nk1 Prim p k a
prim1, MatchNumType Sing p
sp2 Sing k
sk2 NumericBasicType k
nk2 Prim p k a
prim2) ->
    Sing
  (Case_6989586621679836954
     p
     p
     (Case_6989586621679836906 p p (Compare_6989586621679388653 p p)))
-> Sing
     (Case_6989586621679836954
        k
        k
        (Case_6989586621679836906 k k (Compare_6989586621679388662 k k)))
-> Maybe
     (MakePrim
        (Case_6989586621679836954
           p
           p
           (Case_6989586621679836906 p p (Compare_6989586621679388653 p p)))
        (Case_6989586621679836954
           k
           k
           (Case_6989586621679836906 k k (Compare_6989586621679388662 k k))))
forall (p :: Precision) (k :: BasicType).
Sing p -> Sing k -> Maybe (MakePrim p k)
makePrim (Sing p -> Sing p -> Sing (Apply (Apply PrecMaxSym0 p) p)
forall (t1 :: Precision) (t2 :: Precision).
Sing t1 -> Sing t2 -> Sing (Apply (Apply PrecMaxSym0 t1) t2)
sPrecMax Sing p
sp1 Sing p
sp2) (Sing k -> Sing k -> Sing (Apply (Apply BasicTypeMaxSym0 k) k)
forall (t1 :: BasicType) (t2 :: BasicType).
Sing t1 -> Sing t2 -> Sing (Apply (Apply BasicTypeMaxSym0 t1) t2)
sBasicTypeMax Sing k
sk1 Sing k
sk2) Maybe
  (MakePrim
     (Case_6989586621679836954
        p
        p
        (Case_6989586621679836906 p p (Compare_6989586621679388653 p p)))
     (Case_6989586621679836954
        k
        k
        (Case_6989586621679836906 k k (Compare_6989586621679388662 k k))))
-> (MakePrim
      (Case_6989586621679836954
         p
         p
         (Case_6989586621679836906 p p (Compare_6989586621679388653 p p)))
      (Case_6989586621679836954
         k
         k
         (Case_6989586621679836906 k k (Compare_6989586621679388662 k k)))
    -> MatchNumR a b)
-> Maybe (MatchNumR a b)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<$$> \case
      MakePrim Prim
  (Case_6989586621679836954
     p
     p
     (Case_6989586621679836906 p p (Compare_6989586621679388653 p p)))
  (Case_6989586621679836954
     k
     k
     (Case_6989586621679836906 k k (Compare_6989586621679388662 k k)))
  a
prim3 -> NumericBasicType k
-> NumericBasicType k
-> Prim p k a
-> Prim p k a
-> Prim (PrecMax p p) (BasicTypeMax k k) a
-> MatchNumR (PrimS a) (PrimS a)
forall (p2 :: BasicType) (b :: BasicType) (p1 :: Precision) a
       (p2 :: Precision) b c.
NumericBasicType p2
-> NumericBasicType b
-> Prim p1 p2 a
-> Prim p2 b b
-> Prim (PrecMax p1 p2) (BasicTypeMax p2 b) c
-> MatchNumR (PrimS a) (PrimS b)
MatchNumR NumericBasicType k
nk1 NumericBasicType k
nk2 Prim p k a
prim1 Prim p k a
prim2 Prim
  (Case_6989586621679836954
     p
     p
     (Case_6989586621679836906 p p (Compare_6989586621679388653 p p)))
  (Case_6989586621679836954
     k
     k
     (Case_6989586621679836906 k k (Compare_6989586621679388662 k k)))
  a
Prim (PrecMax p p) (BasicTypeMax k k) a
prim3

primCeil :: Prim p1 k1 a -> Prim p2 k2 b -> Maybe (MakePrim (PrecMax p1 p2) (BasicTypeMax k1 k2))
primCeil :: Prim p1 k1 a
-> Prim p2 k2 b
-> Maybe (MakePrim (PrecMax p1 p2) (BasicTypeMax k1 k2))
primCeil Prim p1 k1 a
prim1 Prim p2 k2 b
prim2 = case (Prim p1 k1 a -> MatchPrim p1 k1 a
forall (p :: Precision) (k :: BasicType) a.
Prim p k a -> MatchPrim p k a
matchPrim Prim p1 k1 a
prim1, Prim p2 k2 b -> MatchPrim p2 k2 b
forall (p :: Precision) (k :: BasicType) a.
Prim p k a -> MatchPrim p k a
matchPrim Prim p2 k2 b
prim2) of
  (MatchPrim Sing p1
p1 Sing k1
k1, MatchPrim Sing p2
p2 Sing k2
k2) -> Sing
  (Case_6989586621679836954
     p1
     p2
     (Case_6989586621679836906
        p1 p2 (Compare_6989586621679388653 p1 p2)))
-> Sing
     (Case_6989586621679836954
        k1
        k2
        (Case_6989586621679836906
           k1 k2 (Compare_6989586621679388662 k1 k2)))
-> Maybe
     (MakePrim
        (Case_6989586621679836954
           p1
           p2
           (Case_6989586621679836906
              p1 p2 (Compare_6989586621679388653 p1 p2)))
        (Case_6989586621679836954
           k1
           k2
           (Case_6989586621679836906
              k1 k2 (Compare_6989586621679388662 k1 k2))))
forall (p :: Precision) (k :: BasicType).
Sing p -> Sing k -> Maybe (MakePrim p k)
makePrim (Sing p1 -> Sing p2 -> Sing (Apply (Apply PrecMaxSym0 p1) p2)
forall (t1 :: Precision) (t2 :: Precision).
Sing t1 -> Sing t2 -> Sing (Apply (Apply PrecMaxSym0 t1) t2)
sPrecMax Sing p1
p1 Sing p2
p2) (Sing k1 -> Sing k2 -> Sing (Apply (Apply BasicTypeMaxSym0 k1) k2)
forall (t1 :: BasicType) (t2 :: BasicType).
Sing t1 -> Sing t2 -> Sing (Apply (Apply BasicTypeMaxSym0 t1) t2)
sBasicTypeMax Sing k1
k1 Sing k2
k2)


data MatchCompareR a b where
  MatchCompareR :: ComparableBasicTypes k1 k2 -> Prim p1 k1 a -> Prim p2 k2 b -> MatchCompareR (PrimS a) (PrimS b)

-- | Checks if it is possible to perform a binary comparison (equality or
-- relational) operation on arguments with the given respective types. If so,
-- returns proof of that fact.
matchCompareR :: D a -> D b -> Maybe (MatchCompareR a b)
matchCompareR :: D a -> D b -> Maybe (MatchCompareR a b)
matchCompareR =
  ((D a -> D b -> Maybe (MatchNumR a b))
-> (MatchNumR a b -> Maybe (MatchCompareR a b))
-> D a
-> D b
-> Maybe (MatchCompareR a b)
forall (m :: * -> *) a b c r.
Monad m =>
(a -> b -> m c) -> (c -> m r) -> a -> b -> m r
matchingWithBoth D a -> D b -> Maybe (MatchNumR a b)
forall a b. D a -> D b -> Maybe (MatchNumR a b)
matchNumR ((MatchNumR a b -> Maybe (MatchCompareR a b))
 -> D a -> D b -> Maybe (MatchCompareR a b))
-> (MatchNumR a b -> Maybe (MatchCompareR a b))
-> D a
-> D b
-> Maybe (MatchCompareR a b)
forall a b. (a -> b) -> a -> b
$ MatchCompareR a b -> Maybe (MatchCompareR a b)
forall a. a -> Maybe a
Just (MatchCompareR a b -> Maybe (MatchCompareR a b))
-> (MatchNumR a b -> MatchCompareR a b)
-> MatchNumR a b
-> Maybe (MatchCompareR a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      MatchNumR NumericBasicType k1
nk1 NumericBasicType k2
nk2 Prim p1 k1 a
p1 Prim p2 k2 b
p2 Prim (PrecMax p1 p2) (BasicTypeMax k1 k2) c
_ -> ComparableBasicTypes k1 k2
-> Prim p1 k1 a
-> Prim p2 k2 b
-> MatchCompareR (PrimS a) (PrimS b)
forall (k1 :: BasicType) (k2 :: BasicType) (p1 :: Precision) a
       (p2 :: Precision) b.
ComparableBasicTypes k1 k2
-> Prim p1 k1 a
-> Prim p2 k2 b
-> MatchCompareR (PrimS a) (PrimS b)
MatchCompareR (NumericBasicType k1
-> NumericBasicType k2 -> ComparableBasicTypes k1 k2
forall (k1 :: BasicType) (k2 :: BasicType).
NumericBasicType k1
-> NumericBasicType k2 -> ComparableBasicTypes k1 k2
CBTNum NumericBasicType k1
nk1 NumericBasicType k2
nk2) Prim p1 k1 a
p1 Prim p2 k2 b
p2
  ) (D a -> D b -> Maybe (MatchCompareR a b))
-> (D a -> D b -> Maybe (MatchCompareR a b))
-> D a
-> D b
-> Maybe (MatchCompareR a b)
forall (f :: * -> *) a b c.
Alternative f =>
(a -> b -> f c) -> (a -> b -> f c) -> a -> b -> f c
`altf2`
  ((D a -> Maybe (MatchPrimD a))
-> (D b -> Maybe (MatchPrimD b))
-> ((MatchPrimD a, MatchPrimD b) -> Maybe (MatchCompareR a b))
-> D a
-> D b
-> Maybe (MatchCompareR a b)
forall (m :: * -> *) a a' b b' r.
Monad m =>
(a -> m a') -> (b -> m b') -> ((a', b') -> m r) -> a -> b -> m r
matchingWith2 D a -> Maybe (MatchPrimD a)
forall a. D a -> Maybe (MatchPrimD a)
matchPrimD D b -> Maybe (MatchPrimD b)
forall a. D a -> Maybe (MatchPrimD a)
matchPrimD (((MatchPrimD a, MatchPrimD b) -> Maybe (MatchCompareR a b))
 -> D a -> D b -> Maybe (MatchCompareR a b))
-> ((MatchPrimD a, MatchPrimD b) -> Maybe (MatchCompareR a b))
-> D a
-> D b
-> Maybe (MatchCompareR a b)
forall a b. (a -> b) -> a -> b
$ \case
      (MatchPrimD (MatchPrim Sing p
_ Sing k
SBTLogical) Prim p k a
p1, MatchPrimD (MatchPrim Sing p
_ Sing k
SBTLogical) Prim p k a
p2) ->
        MatchCompareR (PrimS a) (PrimS a)
-> Maybe (MatchCompareR (PrimS a) (PrimS a))
forall a. a -> Maybe a
Just (ComparableBasicTypes 'BTLogical 'BTLogical
-> Prim p 'BTLogical a
-> Prim p 'BTLogical a
-> MatchCompareR (PrimS a) (PrimS a)
forall (k1 :: BasicType) (k2 :: BasicType) (p1 :: Precision) a
       (p2 :: Precision) b.
ComparableBasicTypes k1 k2
-> Prim p1 k1 a
-> Prim p2 k2 b
-> MatchCompareR (PrimS a) (PrimS b)
MatchCompareR ComparableBasicTypes 'BTLogical 'BTLogical
CBTBool Prim p k a
Prim p 'BTLogical a
p1 Prim p k a
Prim p 'BTLogical a
p2)
      (MatchPrimD (MatchPrim Sing p
_ Sing k
SBTChar) Prim p k a
p1, MatchPrimD (MatchPrim Sing p
_ Sing k
SBTChar) Prim p k a
p2) ->
        MatchCompareR (PrimS a) (PrimS a)
-> Maybe (MatchCompareR (PrimS a) (PrimS a))
forall a. a -> Maybe a
Just (ComparableBasicTypes 'BTChar 'BTChar
-> Prim p 'BTChar a
-> Prim p 'BTChar a
-> MatchCompareR (PrimS a) (PrimS a)
forall (k1 :: BasicType) (k2 :: BasicType) (p1 :: Precision) a
       (p2 :: Precision) b.
ComparableBasicTypes k1 k2
-> Prim p1 k1 a
-> Prim p2 k2 b
-> MatchCompareR (PrimS a) (PrimS b)
MatchCompareR ComparableBasicTypes 'BTChar 'BTChar
CBTChar Prim p k a
Prim p 'BTChar a
p1 Prim p k a
Prim p 'BTChar a
p2)
      (MatchPrimD a, MatchPrimD b)
_ -> Maybe (MatchCompareR a b)
forall a. Maybe a
Nothing
  )

--------------------------------------------------------------------------------
--  Matching on operator result types
--------------------------------------------------------------------------------

data MatchOpSpec ok args where
  MatchOpSpec :: OpSpec ok args result -> D result -> MatchOpSpec ok args

-- | Checks if it is possible to apply the given operator to the given
-- arguments, and if so returns a proof of that fact, packaged with information
-- about the result of applying the operator.
matchOpSpec :: Op (Length args) ok -> Rec D args -> Maybe (MatchOpSpec ok args)
matchOpSpec :: Op (Length args) ok -> Rec D args -> Maybe (MatchOpSpec ok args)
matchOpSpec Op (Length args) ok
operator Rec D args
argTypes =
  case Rec D args
argTypes of
    Rec D args
RNil -> case Op (Length args) ok
operator of
      Op (Length args) ok
OpLit -> Maybe (MatchOpSpec ok args)
forall a. Maybe a
Nothing

    D r
d1 :& Rec D rs
RNil -> case Op (Length args) ok
operator of
      Op (Length args) ok
OpNeg -> Maybe (Rec MatchNumType args)
argsNumeric Maybe (Rec MatchNumType args)
-> (Rec MatchNumType args -> MatchOpSpec ok args)
-> Maybe (MatchOpSpec ok args)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<$$> \case
        MatchNumType _ _ nk p :& Rec MatchNumType rs
RNil -> OpSpec 'OKNum '[PrimS a] (PrimS a)
-> D (PrimS a) -> MatchOpSpec 'OKNum '[PrimS a]
forall (ok :: OpKind) (args :: [*]) result.
OpSpec ok args result -> D result -> MatchOpSpec ok args
MatchOpSpec (NumericBasicType k
-> Prim p k a -> Prim p k a -> OpSpec 'OKNum '[PrimS a] (PrimS a)
forall (k1 :: BasicType) (p1 :: Precision) a (k1 :: Precision)
       (k2 :: BasicType) p1.
NumericBasicType k1
-> Prim p1 k1 a
-> Prim k1 k2 p1
-> OpSpec 'OKNum '[PrimS a] (PrimS p1)
OSNum1 NumericBasicType k
nk Prim p k a
p Prim p k a
p) D r
D (PrimS a)
d1
      Op (Length args) ok
OpPos -> Maybe (Rec MatchNumType args)
argsNumeric Maybe (Rec MatchNumType args)
-> (Rec MatchNumType args -> MatchOpSpec ok args)
-> Maybe (MatchOpSpec ok args)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<$$> \case
        MatchNumType _ _ nk p :& Rec MatchNumType rs
RNil -> OpSpec 'OKNum '[PrimS a] (PrimS a)
-> D (PrimS a) -> MatchOpSpec 'OKNum '[PrimS a]
forall (ok :: OpKind) (args :: [*]) result.
OpSpec ok args result -> D result -> MatchOpSpec ok args
MatchOpSpec (NumericBasicType k
-> Prim p k a -> Prim p k a -> OpSpec 'OKNum '[PrimS a] (PrimS a)
forall (k1 :: BasicType) (p1 :: Precision) a (k1 :: Precision)
       (k2 :: BasicType) p1.
NumericBasicType k1
-> Prim p1 k1 a
-> Prim k1 k2 p1
-> OpSpec 'OKNum '[PrimS a] (PrimS p1)
OSNum1 NumericBasicType k
nk Prim p k a
p Prim p k a
p) D r
D (PrimS a)
d1

      Op (Length args) ok
OpNot -> Maybe (Rec MatchPrimD args)
argsPrim Maybe (Rec MatchPrimD args)
-> (Rec MatchPrimD args -> Maybe (MatchOpSpec ok args))
-> Maybe (MatchOpSpec ok args)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        MatchPrimD (MatchPrim _ SBTLogical) p :& Rec MatchPrimD rs
RNil -> MatchOpSpec 'OKLogical '[PrimS a]
-> Maybe (MatchOpSpec 'OKLogical '[PrimS a])
forall a. a -> Maybe a
Just (MatchOpSpec 'OKLogical '[PrimS a]
 -> Maybe (MatchOpSpec 'OKLogical '[PrimS a]))
-> MatchOpSpec 'OKLogical '[PrimS a]
-> Maybe (MatchOpSpec 'OKLogical '[PrimS a])
forall a b. (a -> b) -> a -> b
$ OpSpec 'OKLogical '[PrimS a] (PrimS Bool8)
-> D (PrimS Bool8) -> MatchOpSpec 'OKLogical '[PrimS a]
forall (ok :: OpKind) (args :: [*]) result.
OpSpec ok args result -> D result -> MatchOpSpec ok args
MatchOpSpec (Prim p 'BTLogical a
-> Prim 'P8 'BTLogical Bool8
-> OpSpec 'OKLogical '[PrimS a] (PrimS Bool8)
forall (p1 :: Precision) a b.
Prim p1 'BTLogical a
-> Prim 'P8 'BTLogical b -> OpSpec 'OKLogical '[PrimS a] (PrimS b)
OSLogical1 Prim p k a
Prim p 'BTLogical a
p Prim 'P8 'BTLogical Bool8
PBool8) (Prim 'P8 'BTLogical Bool8 -> D (PrimS Bool8)
forall (p :: Precision) (k :: BasicType) a.
Prim p k a -> D (PrimS a)
DPrim Prim 'P8 'BTLogical Bool8
PBool8)
        Rec MatchPrimD args
_ -> Maybe (MatchOpSpec ok args)
forall a. Maybe a
Nothing

      -- In the deref case, we don't have access to a particular field to
      -- dereference, so there's nothing we can return.
      Op (Length args) ok
OpDeref -> Maybe (MatchOpSpec ok args)
forall a. Maybe a
Nothing

    D r
d1 :& D r
d2 :& Rec D rs
RNil -> case Op (Length args) ok
operator of
      Op (Length args) ok
OpAdd -> D r -> D r -> Maybe (MatchNumR r r)
forall a b. D a -> D b -> Maybe (MatchNumR a b)
matchNumR D r
d1 D r
d2 Maybe (MatchNumR r r)
-> (MatchNumR r r -> MatchOpSpec ok args)
-> Maybe (MatchOpSpec ok args)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<$$> \case
          MatchNumR NumericBasicType k1
nk1 NumericBasicType k2
nk2 Prim p1 k1 a
p1 Prim p2 k2 b
p2 Prim (PrecMax p1 p2) (BasicTypeMax k1 k2) c
p3 -> OpSpec 'OKNum '[PrimS a, PrimS b] (PrimS c)
-> D (PrimS c) -> MatchOpSpec 'OKNum '[PrimS a, PrimS b]
forall (ok :: OpKind) (args :: [*]) result.
OpSpec ok args result -> D result -> MatchOpSpec ok args
MatchOpSpec (NumericBasicType k1
-> NumericBasicType k2
-> Prim p1 k1 a
-> Prim p2 k2 b
-> Prim (PrecMax p1 p2) (BasicTypeMax k1 k2) c
-> OpSpec 'OKNum '[PrimS a, PrimS b] (PrimS c)
forall (k1 :: BasicType) (k2 :: BasicType) (p1 :: Precision) a
       (p2 :: Precision) p1 a.
NumericBasicType k1
-> NumericBasicType k2
-> Prim p1 k1 a
-> Prim p2 k2 p1
-> Prim (PrecMax p1 p2) (BasicTypeMax k1 k2) a
-> OpSpec 'OKNum '[PrimS a, PrimS p1] (PrimS a)
OSNum2 NumericBasicType k1
nk1 NumericBasicType k2
nk2 Prim p1 k1 a
p1 Prim p2 k2 b
p2 Prim (PrecMax p1 p2) (BasicTypeMax k1 k2) c
p3) (Prim
  (Case_6989586621679836954
     p1
     p2
     (Case_6989586621679836906
        p1 p2 (Compare_6989586621679388653 p1 p2)))
  (Case_6989586621679836954
     k1
     k2
     (Case_6989586621679836906
        k1 k2 (Compare_6989586621679388662 k1 k2)))
  c
-> D (PrimS c)
forall (p :: Precision) (k :: BasicType) a.
Prim p k a -> D (PrimS a)
DPrim Prim
  (Case_6989586621679836954
     p1
     p2
     (Case_6989586621679836906
        p1 p2 (Compare_6989586621679388653 p1 p2)))
  (Case_6989586621679836954
     k1
     k2
     (Case_6989586621679836906
        k1 k2 (Compare_6989586621679388662 k1 k2)))
  c
Prim (PrecMax p1 p2) (BasicTypeMax k1 k2) c
p3)
      Op (Length args) ok
OpSub -> D r -> D r -> Maybe (MatchNumR r r)
forall a b. D a -> D b -> Maybe (MatchNumR a b)
matchNumR D r
d1 D r
d2 Maybe (MatchNumR r r)
-> (MatchNumR r r -> MatchOpSpec ok args)
-> Maybe (MatchOpSpec ok args)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<$$> \case
          MatchNumR NumericBasicType k1
nk1 NumericBasicType k2
nk2 Prim p1 k1 a
p1 Prim p2 k2 b
p2 Prim (PrecMax p1 p2) (BasicTypeMax k1 k2) c
p3 -> OpSpec 'OKNum '[PrimS a, PrimS b] (PrimS c)
-> D (PrimS c) -> MatchOpSpec 'OKNum '[PrimS a, PrimS b]
forall (ok :: OpKind) (args :: [*]) result.
OpSpec ok args result -> D result -> MatchOpSpec ok args
MatchOpSpec (NumericBasicType k1
-> NumericBasicType k2
-> Prim p1 k1 a
-> Prim p2 k2 b
-> Prim (PrecMax p1 p2) (BasicTypeMax k1 k2) c
-> OpSpec 'OKNum '[PrimS a, PrimS b] (PrimS c)
forall (k1 :: BasicType) (k2 :: BasicType) (p1 :: Precision) a
       (p2 :: Precision) p1 a.
NumericBasicType k1
-> NumericBasicType k2
-> Prim p1 k1 a
-> Prim p2 k2 p1
-> Prim (PrecMax p1 p2) (BasicTypeMax k1 k2) a
-> OpSpec 'OKNum '[PrimS a, PrimS p1] (PrimS a)
OSNum2 NumericBasicType k1
nk1 NumericBasicType k2
nk2 Prim p1 k1 a
p1 Prim p2 k2 b
p2 Prim (PrecMax p1 p2) (BasicTypeMax k1 k2) c
p3) (Prim
  (Case_6989586621679836954
     p1
     p2
     (Case_6989586621679836906
        p1 p2 (Compare_6989586621679388653 p1 p2)))
  (Case_6989586621679836954
     k1
     k2
     (Case_6989586621679836906
        k1 k2 (Compare_6989586621679388662 k1 k2)))
  c
-> D (PrimS c)
forall (p :: Precision) (k :: BasicType) a.
Prim p k a -> D (PrimS a)
DPrim Prim
  (Case_6989586621679836954
     p1
     p2
     (Case_6989586621679836906
        p1 p2 (Compare_6989586621679388653 p1 p2)))
  (Case_6989586621679836954
     k1
     k2
     (Case_6989586621679836906
        k1 k2 (Compare_6989586621679388662 k1 k2)))
  c
Prim (PrecMax p1 p2) (BasicTypeMax k1 k2) c
p3)
      Op (Length args) ok
OpMul -> D r -> D r -> Maybe (MatchNumR r r)
forall a b. D a -> D b -> Maybe (MatchNumR a b)
matchNumR D r
d1 D r
d2 Maybe (MatchNumR r r)
-> (MatchNumR r r -> MatchOpSpec ok args)
-> Maybe (MatchOpSpec ok args)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<$$> \case
          MatchNumR NumericBasicType k1
nk1 NumericBasicType k2
nk2 Prim p1 k1 a
p1 Prim p2 k2 b
p2 Prim (PrecMax p1 p2) (BasicTypeMax k1 k2) c
p3 -> OpSpec 'OKNum '[PrimS a, PrimS b] (PrimS c)
-> D (PrimS c) -> MatchOpSpec 'OKNum '[PrimS a, PrimS b]
forall (ok :: OpKind) (args :: [*]) result.
OpSpec ok args result -> D result -> MatchOpSpec ok args
MatchOpSpec (NumericBasicType k1
-> NumericBasicType k2
-> Prim p1 k1 a
-> Prim p2 k2 b
-> Prim (PrecMax p1 p2) (BasicTypeMax k1 k2) c
-> OpSpec 'OKNum '[PrimS a, PrimS b] (PrimS c)
forall (k1 :: BasicType) (k2 :: BasicType) (p1 :: Precision) a
       (p2 :: Precision) p1 a.
NumericBasicType k1
-> NumericBasicType k2
-> Prim p1 k1 a
-> Prim p2 k2 p1
-> Prim (PrecMax p1 p2) (BasicTypeMax k1 k2) a
-> OpSpec 'OKNum '[PrimS a, PrimS p1] (PrimS a)
OSNum2 NumericBasicType k1
nk1 NumericBasicType k2
nk2 Prim p1 k1 a
p1 Prim p2 k2 b
p2 Prim (PrecMax p1 p2) (BasicTypeMax k1 k2) c
p3) (Prim
  (Case_6989586621679836954
     p1
     p2
     (Case_6989586621679836906
        p1 p2 (Compare_6989586621679388653 p1 p2)))
  (Case_6989586621679836954
     k1
     k2
     (Case_6989586621679836906
        k1 k2 (Compare_6989586621679388662 k1 k2)))
  c
-> D (PrimS c)
forall (p :: Precision) (k :: BasicType) a.
Prim p k a -> D (PrimS a)
DPrim Prim
  (Case_6989586621679836954
     p1
     p2
     (Case_6989586621679836906
        p1 p2 (Compare_6989586621679388653 p1 p2)))
  (Case_6989586621679836954
     k1
     k2
     (Case_6989586621679836906
        k1 k2 (Compare_6989586621679388662 k1 k2)))
  c
Prim (PrecMax p1 p2) (BasicTypeMax k1 k2) c
p3)
      Op (Length args) ok
OpDiv -> D r -> D r -> Maybe (MatchNumR r r)
forall a b. D a -> D b -> Maybe (MatchNumR a b)
matchNumR D r
d1 D r
d2 Maybe (MatchNumR r r)
-> (MatchNumR r r -> MatchOpSpec ok args)
-> Maybe (MatchOpSpec ok args)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<$$> \case
          MatchNumR NumericBasicType k1
nk1 NumericBasicType k2
nk2 Prim p1 k1 a
p1 Prim p2 k2 b
p2 Prim (PrecMax p1 p2) (BasicTypeMax k1 k2) c
p3 -> OpSpec 'OKNum '[PrimS a, PrimS b] (PrimS c)
-> D (PrimS c) -> MatchOpSpec 'OKNum '[PrimS a, PrimS b]
forall (ok :: OpKind) (args :: [*]) result.
OpSpec ok args result -> D result -> MatchOpSpec ok args
MatchOpSpec (NumericBasicType k1
-> NumericBasicType k2
-> Prim p1 k1 a
-> Prim p2 k2 b
-> Prim (PrecMax p1 p2) (BasicTypeMax k1 k2) c
-> OpSpec 'OKNum '[PrimS a, PrimS b] (PrimS c)
forall (k1 :: BasicType) (k2 :: BasicType) (p1 :: Precision) a
       (p2 :: Precision) p1 a.
NumericBasicType k1
-> NumericBasicType k2
-> Prim p1 k1 a
-> Prim p2 k2 p1
-> Prim (PrecMax p1 p2) (BasicTypeMax k1 k2) a
-> OpSpec 'OKNum '[PrimS a, PrimS p1] (PrimS a)
OSNum2 NumericBasicType k1
nk1 NumericBasicType k2
nk2 Prim p1 k1 a
p1 Prim p2 k2 b
p2 Prim (PrecMax p1 p2) (BasicTypeMax k1 k2) c
p3) (Prim
  (Case_6989586621679836954
     p1
     p2
     (Case_6989586621679836906
        p1 p2 (Compare_6989586621679388653 p1 p2)))
  (Case_6989586621679836954
     k1
     k2
     (Case_6989586621679836906
        k1 k2 (Compare_6989586621679388662 k1 k2)))
  c
-> D (PrimS c)
forall (p :: Precision) (k :: BasicType) a.
Prim p k a -> D (PrimS a)
DPrim Prim
  (Case_6989586621679836954
     p1
     p2
     (Case_6989586621679836906
        p1 p2 (Compare_6989586621679388653 p1 p2)))
  (Case_6989586621679836954
     k1
     k2
     (Case_6989586621679836906
        k1 k2 (Compare_6989586621679388662 k1 k2)))
  c
Prim (PrecMax p1 p2) (BasicTypeMax k1 k2) c
p3)

      Op (Length args) ok
OpAnd -> Maybe (Rec MatchPrimD args)
argsPrim Maybe (Rec MatchPrimD args)
-> (Rec MatchPrimD args -> Maybe (MatchOpSpec ok args))
-> Maybe (MatchOpSpec ok args)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        MatchPrimD (MatchPrim _ SBTLogical) p1 :& MatchPrimD (MatchPrim _ SBTLogical) p2 :& Rec MatchPrimD rs
RNil ->
          MatchOpSpec 'OKLogical '[PrimS a, PrimS a]
-> Maybe (MatchOpSpec 'OKLogical '[PrimS a, PrimS a])
forall a. a -> Maybe a
Just (MatchOpSpec 'OKLogical '[PrimS a, PrimS a]
 -> Maybe (MatchOpSpec 'OKLogical '[PrimS a, PrimS a]))
-> MatchOpSpec 'OKLogical '[PrimS a, PrimS a]
-> Maybe (MatchOpSpec 'OKLogical '[PrimS a, PrimS a])
forall a b. (a -> b) -> a -> b
$ OpSpec 'OKLogical '[PrimS a, PrimS a] (PrimS Bool8)
-> D (PrimS Bool8) -> MatchOpSpec 'OKLogical '[PrimS a, PrimS a]
forall (ok :: OpKind) (args :: [*]) result.
OpSpec ok args result -> D result -> MatchOpSpec ok args
MatchOpSpec (Prim p 'BTLogical a
-> Prim p 'BTLogical a
-> Prim 'P8 'BTLogical Bool8
-> OpSpec 'OKLogical '[PrimS a, PrimS a] (PrimS Bool8)
forall (p1 :: Precision) a (p2 :: Precision) b c.
Prim p1 'BTLogical a
-> Prim p2 'BTLogical b
-> Prim 'P8 'BTLogical c
-> OpSpec 'OKLogical '[PrimS a, PrimS b] (PrimS c)
OSLogical2 Prim p k a
Prim p 'BTLogical a
p1 Prim p k a
Prim p 'BTLogical a
p2 Prim 'P8 'BTLogical Bool8
PBool8) (Prim 'P8 'BTLogical Bool8 -> D (PrimS Bool8)
forall (p :: Precision) (k :: BasicType) a.
Prim p k a -> D (PrimS a)
DPrim Prim 'P8 'BTLogical Bool8
PBool8)
        Rec MatchPrimD args
_ -> Maybe (MatchOpSpec ok args)
forall a. Maybe a
Nothing
      Op (Length args) ok
OpOr -> Maybe (Rec MatchPrimD args)
argsPrim Maybe (Rec MatchPrimD args)
-> (Rec MatchPrimD args -> Maybe (MatchOpSpec ok args))
-> Maybe (MatchOpSpec ok args)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        MatchPrimD (MatchPrim _ SBTLogical) p1 :& MatchPrimD (MatchPrim _ SBTLogical) p2 :& Rec MatchPrimD rs
RNil ->
          MatchOpSpec 'OKLogical '[PrimS a, PrimS a]
-> Maybe (MatchOpSpec 'OKLogical '[PrimS a, PrimS a])
forall a. a -> Maybe a
Just (MatchOpSpec 'OKLogical '[PrimS a, PrimS a]
 -> Maybe (MatchOpSpec 'OKLogical '[PrimS a, PrimS a]))
-> MatchOpSpec 'OKLogical '[PrimS a, PrimS a]
-> Maybe (MatchOpSpec 'OKLogical '[PrimS a, PrimS a])
forall a b. (a -> b) -> a -> b
$ OpSpec 'OKLogical '[PrimS a, PrimS a] (PrimS Bool8)
-> D (PrimS Bool8) -> MatchOpSpec 'OKLogical '[PrimS a, PrimS a]
forall (ok :: OpKind) (args :: [*]) result.
OpSpec ok args result -> D result -> MatchOpSpec ok args
MatchOpSpec (Prim p 'BTLogical a
-> Prim p 'BTLogical a
-> Prim 'P8 'BTLogical Bool8
-> OpSpec 'OKLogical '[PrimS a, PrimS a] (PrimS Bool8)
forall (p1 :: Precision) a (p2 :: Precision) b c.
Prim p1 'BTLogical a
-> Prim p2 'BTLogical b
-> Prim 'P8 'BTLogical c
-> OpSpec 'OKLogical '[PrimS a, PrimS b] (PrimS c)
OSLogical2 Prim p k a
Prim p 'BTLogical a
p1 Prim p k a
Prim p 'BTLogical a
p2 Prim 'P8 'BTLogical Bool8
PBool8) (Prim 'P8 'BTLogical Bool8 -> D (PrimS Bool8)
forall (p :: Precision) (k :: BasicType) a.
Prim p k a -> D (PrimS a)
DPrim Prim 'P8 'BTLogical Bool8
PBool8)
        Rec MatchPrimD args
_ -> Maybe (MatchOpSpec ok args)
forall a. Maybe a
Nothing
      Op (Length args) ok
OpEquiv -> Maybe (Rec MatchPrimD args)
argsPrim Maybe (Rec MatchPrimD args)
-> (Rec MatchPrimD args -> Maybe (MatchOpSpec ok args))
-> Maybe (MatchOpSpec ok args)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        MatchPrimD (MatchPrim _ SBTLogical) p1 :& MatchPrimD (MatchPrim _ SBTLogical) p2 :& Rec MatchPrimD rs
RNil ->
          MatchOpSpec 'OKLogical '[PrimS a, PrimS a]
-> Maybe (MatchOpSpec 'OKLogical '[PrimS a, PrimS a])
forall a. a -> Maybe a
Just (MatchOpSpec 'OKLogical '[PrimS a, PrimS a]
 -> Maybe (MatchOpSpec 'OKLogical '[PrimS a, PrimS a]))
-> MatchOpSpec 'OKLogical '[PrimS a, PrimS a]
-> Maybe (MatchOpSpec 'OKLogical '[PrimS a, PrimS a])
forall a b. (a -> b) -> a -> b
$ OpSpec 'OKLogical '[PrimS a, PrimS a] (PrimS Bool8)
-> D (PrimS Bool8) -> MatchOpSpec 'OKLogical '[PrimS a, PrimS a]
forall (ok :: OpKind) (args :: [*]) result.
OpSpec ok args result -> D result -> MatchOpSpec ok args
MatchOpSpec (Prim p 'BTLogical a
-> Prim p 'BTLogical a
-> Prim 'P8 'BTLogical Bool8
-> OpSpec 'OKLogical '[PrimS a, PrimS a] (PrimS Bool8)
forall (p1 :: Precision) a (p2 :: Precision) b c.
Prim p1 'BTLogical a
-> Prim p2 'BTLogical b
-> Prim 'P8 'BTLogical c
-> OpSpec 'OKLogical '[PrimS a, PrimS b] (PrimS c)
OSLogical2 Prim p k a
Prim p 'BTLogical a
p1 Prim p k a
Prim p 'BTLogical a
p2 Prim 'P8 'BTLogical Bool8
PBool8) (Prim 'P8 'BTLogical Bool8 -> D (PrimS Bool8)
forall (p :: Precision) (k :: BasicType) a.
Prim p k a -> D (PrimS a)
DPrim Prim 'P8 'BTLogical Bool8
PBool8)
        Rec MatchPrimD args
_ -> Maybe (MatchOpSpec ok args)
forall a. Maybe a
Nothing
      Op (Length args) ok
OpNotEquiv -> Maybe (Rec MatchPrimD args)
argsPrim Maybe (Rec MatchPrimD args)
-> (Rec MatchPrimD args -> Maybe (MatchOpSpec ok args))
-> Maybe (MatchOpSpec ok args)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        MatchPrimD (MatchPrim _ SBTLogical) p1 :& MatchPrimD (MatchPrim _ SBTLogical) p2 :& Rec MatchPrimD rs
RNil ->
          MatchOpSpec 'OKLogical '[PrimS a, PrimS a]
-> Maybe (MatchOpSpec 'OKLogical '[PrimS a, PrimS a])
forall a. a -> Maybe a
Just (MatchOpSpec 'OKLogical '[PrimS a, PrimS a]
 -> Maybe (MatchOpSpec 'OKLogical '[PrimS a, PrimS a]))
-> MatchOpSpec 'OKLogical '[PrimS a, PrimS a]
-> Maybe (MatchOpSpec 'OKLogical '[PrimS a, PrimS a])
forall a b. (a -> b) -> a -> b
$ OpSpec 'OKLogical '[PrimS a, PrimS a] (PrimS Bool8)
-> D (PrimS Bool8) -> MatchOpSpec 'OKLogical '[PrimS a, PrimS a]
forall (ok :: OpKind) (args :: [*]) result.
OpSpec ok args result -> D result -> MatchOpSpec ok args
MatchOpSpec (Prim p 'BTLogical a
-> Prim p 'BTLogical a
-> Prim 'P8 'BTLogical Bool8
-> OpSpec 'OKLogical '[PrimS a, PrimS a] (PrimS Bool8)
forall (p1 :: Precision) a (p2 :: Precision) b c.
Prim p1 'BTLogical a
-> Prim p2 'BTLogical b
-> Prim 'P8 'BTLogical c
-> OpSpec 'OKLogical '[PrimS a, PrimS b] (PrimS c)
OSLogical2 Prim p k a
Prim p 'BTLogical a
p1 Prim p k a
Prim p 'BTLogical a
p2 Prim 'P8 'BTLogical Bool8
PBool8) (Prim 'P8 'BTLogical Bool8 -> D (PrimS Bool8)
forall (p :: Precision) (k :: BasicType) a.
Prim p k a -> D (PrimS a)
DPrim Prim 'P8 'BTLogical Bool8
PBool8)
        Rec MatchPrimD args
_ -> Maybe (MatchOpSpec ok args)
forall a. Maybe a
Nothing

      Op (Length args) ok
OpEq -> D r -> D r -> Maybe (MatchCompareR r r)
forall a b. D a -> D b -> Maybe (MatchCompareR a b)
matchCompareR D r
d1 D r
d2 Maybe (MatchCompareR r r)
-> (MatchCompareR r r -> MatchOpSpec ok args)
-> Maybe (MatchOpSpec ok args)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<$$> \case
        MatchCompareR ComparableBasicTypes k1 k2
cmp Prim p1 k1 a
p1 Prim p2 k2 b
p2 -> OpSpec 'OKEq '[PrimS a, PrimS b] (PrimS Bool8)
-> D (PrimS Bool8) -> MatchOpSpec 'OKEq '[PrimS a, PrimS b]
forall (ok :: OpKind) (args :: [*]) result.
OpSpec ok args result -> D result -> MatchOpSpec ok args
MatchOpSpec (ComparableBasicTypes k1 k2
-> Prim p1 k1 a
-> Prim p2 k2 b
-> Prim 'P8 'BTLogical Bool8
-> OpSpec 'OKEq '[PrimS a, PrimS b] (PrimS Bool8)
forall (k1 :: BasicType) (k2 :: BasicType) (p1 :: Precision) a
       (p2 :: Precision) b c.
ComparableBasicTypes k1 k2
-> Prim p1 k1 a
-> Prim p2 k2 b
-> Prim 'P8 'BTLogical c
-> OpSpec 'OKEq '[PrimS a, PrimS b] (PrimS c)
OSEq ComparableBasicTypes k1 k2
cmp Prim p1 k1 a
p1 Prim p2 k2 b
p2 Prim 'P8 'BTLogical Bool8
PBool8) (Prim 'P8 'BTLogical Bool8 -> D (PrimS Bool8)
forall (p :: Precision) (k :: BasicType) a.
Prim p k a -> D (PrimS a)
DPrim Prim 'P8 'BTLogical Bool8
PBool8)
      Op (Length args) ok
OpNE -> D r -> D r -> Maybe (MatchCompareR r r)
forall a b. D a -> D b -> Maybe (MatchCompareR a b)
matchCompareR D r
d1 D r
d2 Maybe (MatchCompareR r r)
-> (MatchCompareR r r -> MatchOpSpec ok args)
-> Maybe (MatchOpSpec ok args)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<$$> \case
        MatchCompareR ComparableBasicTypes k1 k2
cmp Prim p1 k1 a
p1 Prim p2 k2 b
p2 -> OpSpec 'OKEq '[PrimS a, PrimS b] (PrimS Bool8)
-> D (PrimS Bool8) -> MatchOpSpec 'OKEq '[PrimS a, PrimS b]
forall (ok :: OpKind) (args :: [*]) result.
OpSpec ok args result -> D result -> MatchOpSpec ok args
MatchOpSpec (ComparableBasicTypes k1 k2
-> Prim p1 k1 a
-> Prim p2 k2 b
-> Prim 'P8 'BTLogical Bool8
-> OpSpec 'OKEq '[PrimS a, PrimS b] (PrimS Bool8)
forall (k1 :: BasicType) (k2 :: BasicType) (p1 :: Precision) a
       (p2 :: Precision) b c.
ComparableBasicTypes k1 k2
-> Prim p1 k1 a
-> Prim p2 k2 b
-> Prim 'P8 'BTLogical c
-> OpSpec 'OKEq '[PrimS a, PrimS b] (PrimS c)
OSEq ComparableBasicTypes k1 k2
cmp Prim p1 k1 a
p1 Prim p2 k2 b
p2 Prim 'P8 'BTLogical Bool8
PBool8) (Prim 'P8 'BTLogical Bool8 -> D (PrimS Bool8)
forall (p :: Precision) (k :: BasicType) a.
Prim p k a -> D (PrimS a)
DPrim Prim 'P8 'BTLogical Bool8
PBool8)
      Op (Length args) ok
OpLT -> D r -> D r -> Maybe (MatchCompareR r r)
forall a b. D a -> D b -> Maybe (MatchCompareR a b)
matchCompareR D r
d1 D r
d2 Maybe (MatchCompareR r r)
-> (MatchCompareR r r -> MatchOpSpec ok args)
-> Maybe (MatchOpSpec ok args)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<$$> \case
        MatchCompareR ComparableBasicTypes k1 k2
cmp Prim p1 k1 a
p1 Prim p2 k2 b
p2 -> OpSpec 'OKRel '[PrimS a, PrimS b] (PrimS Bool8)
-> D (PrimS Bool8) -> MatchOpSpec 'OKRel '[PrimS a, PrimS b]
forall (ok :: OpKind) (args :: [*]) result.
OpSpec ok args result -> D result -> MatchOpSpec ok args
MatchOpSpec (ComparableBasicTypes k1 k2
-> Prim p1 k1 a
-> Prim p2 k2 b
-> Prim 'P8 'BTLogical Bool8
-> OpSpec 'OKRel '[PrimS a, PrimS b] (PrimS Bool8)
forall (k1 :: BasicType) (k2 :: BasicType) (p1 :: Precision) a
       (p2 :: Precision) b c.
ComparableBasicTypes k1 k2
-> Prim p1 k1 a
-> Prim p2 k2 b
-> Prim 'P8 'BTLogical c
-> OpSpec 'OKRel '[PrimS a, PrimS b] (PrimS c)
OSRel ComparableBasicTypes k1 k2
cmp Prim p1 k1 a
p1 Prim p2 k2 b
p2 Prim 'P8 'BTLogical Bool8
PBool8) (Prim 'P8 'BTLogical Bool8 -> D (PrimS Bool8)
forall (p :: Precision) (k :: BasicType) a.
Prim p k a -> D (PrimS a)
DPrim Prim 'P8 'BTLogical Bool8
PBool8)
      Op (Length args) ok
OpLE -> D r -> D r -> Maybe (MatchCompareR r r)
forall a b. D a -> D b -> Maybe (MatchCompareR a b)
matchCompareR D r
d1 D r
d2 Maybe (MatchCompareR r r)
-> (MatchCompareR r r -> MatchOpSpec ok args)
-> Maybe (MatchOpSpec ok args)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<$$> \case
        MatchCompareR ComparableBasicTypes k1 k2
cmp Prim p1 k1 a
p1 Prim p2 k2 b
p2 -> OpSpec 'OKRel '[PrimS a, PrimS b] (PrimS Bool8)
-> D (PrimS Bool8) -> MatchOpSpec 'OKRel '[PrimS a, PrimS b]
forall (ok :: OpKind) (args :: [*]) result.
OpSpec ok args result -> D result -> MatchOpSpec ok args
MatchOpSpec (ComparableBasicTypes k1 k2
-> Prim p1 k1 a
-> Prim p2 k2 b
-> Prim 'P8 'BTLogical Bool8
-> OpSpec 'OKRel '[PrimS a, PrimS b] (PrimS Bool8)
forall (k1 :: BasicType) (k2 :: BasicType) (p1 :: Precision) a
       (p2 :: Precision) b c.
ComparableBasicTypes k1 k2
-> Prim p1 k1 a
-> Prim p2 k2 b
-> Prim 'P8 'BTLogical c
-> OpSpec 'OKRel '[PrimS a, PrimS b] (PrimS c)
OSRel ComparableBasicTypes k1 k2
cmp Prim p1 k1 a
p1 Prim p2 k2 b
p2 Prim 'P8 'BTLogical Bool8
PBool8) (Prim 'P8 'BTLogical Bool8 -> D (PrimS Bool8)
forall (p :: Precision) (k :: BasicType) a.
Prim p k a -> D (PrimS a)
DPrim Prim 'P8 'BTLogical Bool8
PBool8)
      Op (Length args) ok
OpGT -> D r -> D r -> Maybe (MatchCompareR r r)
forall a b. D a -> D b -> Maybe (MatchCompareR a b)
matchCompareR D r
d1 D r
d2 Maybe (MatchCompareR r r)
-> (MatchCompareR r r -> MatchOpSpec ok args)
-> Maybe (MatchOpSpec ok args)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<$$> \case
        MatchCompareR ComparableBasicTypes k1 k2
cmp Prim p1 k1 a
p1 Prim p2 k2 b
p2 -> OpSpec 'OKRel '[PrimS a, PrimS b] (PrimS Bool8)
-> D (PrimS Bool8) -> MatchOpSpec 'OKRel '[PrimS a, PrimS b]
forall (ok :: OpKind) (args :: [*]) result.
OpSpec ok args result -> D result -> MatchOpSpec ok args
MatchOpSpec (ComparableBasicTypes k1 k2
-> Prim p1 k1 a
-> Prim p2 k2 b
-> Prim 'P8 'BTLogical Bool8
-> OpSpec 'OKRel '[PrimS a, PrimS b] (PrimS Bool8)
forall (k1 :: BasicType) (k2 :: BasicType) (p1 :: Precision) a
       (p2 :: Precision) b c.
ComparableBasicTypes k1 k2
-> Prim p1 k1 a
-> Prim p2 k2 b
-> Prim 'P8 'BTLogical c
-> OpSpec 'OKRel '[PrimS a, PrimS b] (PrimS c)
OSRel ComparableBasicTypes k1 k2
cmp Prim p1 k1 a
p1 Prim p2 k2 b
p2 Prim 'P8 'BTLogical Bool8
PBool8) (Prim 'P8 'BTLogical Bool8 -> D (PrimS Bool8)
forall (p :: Precision) (k :: BasicType) a.
Prim p k a -> D (PrimS a)
DPrim Prim 'P8 'BTLogical Bool8
PBool8)
      Op (Length args) ok
OpGE -> D r -> D r -> Maybe (MatchCompareR r r)
forall a b. D a -> D b -> Maybe (MatchCompareR a b)
matchCompareR D r
d1 D r
d2 Maybe (MatchCompareR r r)
-> (MatchCompareR r r -> MatchOpSpec ok args)
-> Maybe (MatchOpSpec ok args)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<$$> \case
        MatchCompareR ComparableBasicTypes k1 k2
cmp Prim p1 k1 a
p1 Prim p2 k2 b
p2 -> OpSpec 'OKRel '[PrimS a, PrimS b] (PrimS Bool8)
-> D (PrimS Bool8) -> MatchOpSpec 'OKRel '[PrimS a, PrimS b]
forall (ok :: OpKind) (args :: [*]) result.
OpSpec ok args result -> D result -> MatchOpSpec ok args
MatchOpSpec (ComparableBasicTypes k1 k2
-> Prim p1 k1 a
-> Prim p2 k2 b
-> Prim 'P8 'BTLogical Bool8
-> OpSpec 'OKRel '[PrimS a, PrimS b] (PrimS Bool8)
forall (k1 :: BasicType) (k2 :: BasicType) (p1 :: Precision) a
       (p2 :: Precision) b c.
ComparableBasicTypes k1 k2
-> Prim p1 k1 a
-> Prim p2 k2 b
-> Prim 'P8 'BTLogical c
-> OpSpec 'OKRel '[PrimS a, PrimS b] (PrimS c)
OSRel ComparableBasicTypes k1 k2
cmp Prim p1 k1 a
p1 Prim p2 k2 b
p2 Prim 'P8 'BTLogical Bool8
PBool8) (Prim 'P8 'BTLogical Bool8 -> D (PrimS Bool8)
forall (p :: Precision) (k :: BasicType) a.
Prim p k a -> D (PrimS a)
DPrim Prim 'P8 'BTLogical Bool8
PBool8)

      Op (Length args) ok
OpLookup -> (D r, D r)
-> ((D r, D r) -> Maybe (MatchOpSpec ok args))
-> Maybe (MatchOpSpec ok args)
forall a b. a -> (a -> b) -> b
with (D r
d1, D r
d2) (((D r, D r) -> Maybe (MatchOpSpec ok args))
 -> Maybe (MatchOpSpec ok args))
-> ((D r, D r) -> Maybe (MatchOpSpec ok args))
-> Maybe (MatchOpSpec ok args)
forall a b. (a -> b) -> a -> b
$ LensLike Maybe (D r, D r) (D r, MatchPrimD r) (D r) (MatchPrimD r)
-> LensLike
     Maybe (D r, D r) (D r, MatchPrimD r) (D r) (MatchPrimD r)
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike Maybe (D r, D r) (D r, MatchPrimD r) (D r) (MatchPrimD r)
forall s t a b. Field2 s t a b => Lens s t a b
_2 D r -> Maybe (MatchPrimD r)
forall a. D a -> Maybe (MatchPrimD a)
matchPrimD ((D r, D r) -> Maybe (D r, MatchPrimD r))
-> ((D r, MatchPrimD r) -> Maybe (MatchOpSpec ok args))
-> (D r, D r)
-> Maybe (MatchOpSpec ok args)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \case
        (DArray (Index Prim p 'BTInt a
pi1) ArrValue a
av, MatchPrimD _ pi2) -> case Prim p 'BTInt a
-> Prim p k a -> Maybe ('(p, 'BTInt, a) :~: '(p, k, a))
forall (p1 :: Precision) (k1 :: BasicType) a (p2 :: Precision)
       (k2 :: BasicType) b.
Prim p1 k1 a
-> Prim p2 k2 b -> Maybe ('(p1, k1, a) :~: '(p2, k2, b))
eqPrim Prim p 'BTInt a
pi1 Prim p k a
pi2 of
          Just '(p, 'BTInt, a) :~: '(p, k, a)
Refl -> MatchOpSpec 'OKLookup '[Array (PrimS a) a, PrimS a]
-> Maybe (MatchOpSpec 'OKLookup '[Array (PrimS a) a, PrimS a])
forall a. a -> Maybe a
Just (MatchOpSpec 'OKLookup '[Array (PrimS a) a, PrimS a]
 -> Maybe (MatchOpSpec 'OKLookup '[Array (PrimS a) a, PrimS a]))
-> MatchOpSpec 'OKLookup '[Array (PrimS a) a, PrimS a]
-> Maybe (MatchOpSpec 'OKLookup '[Array (PrimS a) a, PrimS a])
forall a b. (a -> b) -> a -> b
$ OpSpec 'OKLookup '[Array (PrimS a) a, PrimS a] a
-> D a -> MatchOpSpec 'OKLookup '[Array (PrimS a) a, PrimS a]
forall (ok :: OpKind) (args :: [*]) result.
OpSpec ok args result -> D result -> MatchOpSpec ok args
MatchOpSpec (D (Array (PrimS a) a)
-> OpSpec 'OKLookup '[Array (PrimS a) a, PrimS a] a
forall i v. D (Array i v) -> OpSpec 'OKLookup '[Array i v, i] v
OSLookup D r
D (Array (PrimS a) a)
d1) (ArrValue a -> D a
forall a. ArrValue a -> D a
dArrValue ArrValue a
av)
          Maybe ('(p, 'BTInt, a) :~: '(p, k, a))
_         -> Maybe (MatchOpSpec ok args)
forall a. Maybe a
Nothing
        (D r, MatchPrimD r)
_ -> Maybe (MatchOpSpec ok args)
forall a. Maybe a
Nothing

    Rec D args
_ -> Maybe (MatchOpSpec ok args)
forall a. Maybe a
Nothing

  where
    argsNumeric :: Maybe (Rec MatchNumType args)
argsNumeric = (forall a. D a -> Maybe (MatchNumType a))
-> Rec D args -> Maybe (Rec MatchNumType args)
forall u (h :: * -> *) (f :: u -> *) (g :: u -> *) (rs :: [u]).
Applicative h =>
(forall (x :: u). f x -> h (g x)) -> Rec f rs -> h (Rec g rs)
rtraverse forall a. D a -> Maybe (MatchNumType a)
matchNumType Rec D args
argTypes
    argsPrim :: Maybe (Rec MatchPrimD args)
argsPrim = (forall a. D a -> Maybe (MatchPrimD a))
-> Rec D args -> Maybe (Rec MatchPrimD args)
forall u (h :: * -> *) (f :: u -> *) (g :: u -> *) (rs :: [u]).
Applicative h =>
(forall (x :: u). f x -> h (g x)) -> Rec f rs -> h (Rec g rs)
rtraverse forall a. D a -> Maybe (MatchPrimD a)
matchPrimD Rec D args
argTypes