never executed always true always false

    1 {-# LANGUAGE DeriveGeneric, DeriveDataTypeable, DeriveFunctor, DeriveTraversable, DeriveFoldable #-}
    2 
    3 module Conjure.Language.Expression.Op.ElementId where
    4 
    5 import Conjure.Prelude
    6 import Conjure.Language.Expression.Op.Internal.Common
    7 
    8 import qualified Data.Aeson as JSON             -- aeson
    9 import qualified Data.Aeson.KeyMap as KM
   10 
   11 import qualified Data.Vector as V               -- vector
   12 
   13 
   14 data OpElementId x = OpElementId x -- X: variables
   15                                  x -- indexee
   16     deriving (Eq, Ord, Show, Data, Functor, Traversable, Foldable, Typeable, Generic)
   17 
   18 instance Serialize x => Serialize (OpElementId x)
   19 instance Hashable  x => Hashable  (OpElementId x)
   20 instance ToJSON    x => ToJSON    (OpElementId x) where toJSON = genericToJSON jsonOptions
   21 instance FromJSON  x => FromJSON  (OpElementId x) where parseJSON = genericParseJSON jsonOptions
   22 
   23 instance (TypeOf x, Pretty x) => TypeOf (OpElementId x) where
   24     typeOf p@(OpElementId m ix) = do
   25         tyM <- typeOf m
   26         tyI <- typeOf ix
   27         case tyM of
   28             TypeMatrix tyIndex inn
   29                 | typesUnify [tyIndex, tyI] -> return inn
   30                 | otherwise -> failDoc $ "Indexing with inappropriate type, matrix:" <++> vcat
   31                     [ "The expression:"  <+> pretty p
   32                     , "Indexing:"        <+> pretty m
   33                     , "Expected type of index:" <+> pretty tyIndex
   34                     , "Actual type of index  :" <+> pretty tyI
   35                     ]
   36             TypeList inn
   37                 | typesUnify [TypeInt TagInt, tyI] -> return inn
   38                 | otherwise -> failDoc $ "Indexing with inappropriate type, list:" <++> vcat
   39                     [ "The expression:"  <+> pretty p
   40                     , "Indexing:"        <+> pretty m
   41                     , "Expected type of index:" <+> pretty (TypeInt TagInt)
   42                     , "Actual type of index  :" <+> pretty tyI
   43                     ]
   44             _ -> failDoc $ "Indexing something other than a matrix or a tuple:" <++> vcat
   45                     [ "The expression:" <+> pretty p
   46                     , "Indexing:"       <+> pretty m
   47                     , "With type:"      <+> pretty tyM
   48                     ]
   49 
   50 instance SimplifyOp OpElementId x where
   51     simplifyOp _ = na "simplifyOp{OpElementId}"
   52 
   53 instance Pretty x => Pretty (OpElementId x) where
   54     prettyPrec _ (OpElementId a b) = "elementId" <> prettyList prParens "," [a, b]
   55 
   56 instance (VarSymBreakingDescription x, ExpressionLike x) => VarSymBreakingDescription (OpElementId x) where
   57     varSymBreakingDescription (OpElementId a b) = JSON.Object $ KM.fromList
   58         [ ("type", JSON.String "OpElementId")
   59         , ("children", JSON.Array $ V.fromList [ varSymBreakingDescription a
   60                                                , varSymBreakingDescription b
   61                                                ])
   62         ]