1
1
mirror of https://github.com/github/semantic.git synced 2024-12-23 14:54:16 +03:00

Define Generic1 & Eq1 instances for statements.

This commit is contained in:
Rob Rix 2017-04-06 11:27:51 -04:00
parent 30ffbe6421
commit ae2b122b85

View File

@ -1,58 +1,87 @@
{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE StandaloneDeriving #-}
module Data.Syntax.Statement where module Data.Syntax.Statement where
import Data.Functor.Classes.Eq.Generic
import GHC.Generics
import Prologue import Prologue
-- | Conditional. This must have an else block, which can be filled with some default value when omitted in the source, e.g. 'pure ()' for C-style if-without-else or 'pure Nothing' for Ruby-style, in both cases assuming some appropriate Applicative context into which the If will be lifted. -- | Conditional. This must have an else block, which can be filled with some default value when omitted in the source, e.g. 'pure ()' for C-style if-without-else or 'pure Nothing' for Ruby-style, in both cases assuming some appropriate Applicative context into which the If will be lifted.
data If a = If { ifCondition :: !a, ifThenBody :: !a, ifElseBody :: !a } data If a = If { ifCondition :: !a, ifThenBody :: !a, ifElseBody :: !a }
deriving (Eq, Show) deriving (Eq, Generic1, Show)
instance Eq1 If where liftEq = genericLiftEq
-- TODO: Alternative definition would flatten if/else if/else chains: data If a = If ![(a, a)] !(Maybe a) -- TODO: Alternative definition would flatten if/else if/else chains: data If a = If ![(a, a)] !(Maybe a)
-- | A pattern-matching or computed jump control-flow statement, like 'switch' in C or JavaScript, or 'case' in Ruby or Haskell. -- | A pattern-matching or computed jump control-flow statement, like 'switch' in C or JavaScript, or 'case' in Ruby or Haskell.
data Match with a = Switch { matchSubject :: !a, matchPatterns :: ![with a] } data Match with a = Switch { matchSubject :: !a, matchPatterns :: ![with a] }
deriving (Eq, Show) deriving (Eq, Generic1, Show)
instance Eq1 with => Eq1 (Match with) where liftEq = genericLiftEq
-- | A pattern in a pattern-matching or computed jump control-flow statement, like 'case' in C or JavaScript, 'when' in Ruby, or the left-hand side of '->' in the body of Haskell 'case' expressions. -- | A pattern in a pattern-matching or computed jump control-flow statement, like 'case' in C or JavaScript, 'when' in Ruby, or the left-hand side of '->' in the body of Haskell 'case' expressions.
newtype Pattern a = Pattern a newtype Pattern a = Pattern a
deriving (Eq, Show) deriving (Eq, Generic1, Show)
instance Eq1 Pattern where liftEq = genericLiftEq
-- Returns -- Returns
newtype Return a = Return a newtype Return a = Return a
deriving (Eq, Show) deriving (Eq, Generic1, Show)
instance Eq1 Return where liftEq = genericLiftEq
newtype Yield a = Yield a newtype Yield a = Yield a
deriving (Eq, Show) deriving (Eq, Generic1, Show)
instance Eq1 Yield where liftEq = genericLiftEq
-- Loops -- Loops
data For a = For { forBefore :: !a, forCondition :: !a, forStep :: !a, forBody :: !a } data For a = For { forBefore :: !a, forCondition :: !a, forStep :: !a, forBody :: !a }
deriving (Eq, Show) deriving (Eq, Generic1, Show)
instance Eq1 For where liftEq = genericLiftEq
data ForEach a = ForEach { forEachBinding :: !a, forEachSubject :: !a, forEachBody :: !a } data ForEach a = ForEach { forEachBinding :: !a, forEachSubject :: !a, forEachBody :: !a }
deriving (Eq, Show) deriving (Eq, Generic1, Show)
instance Eq1 ForEach where liftEq = genericLiftEq
data While a = While { whileCondition :: !a, whileBody :: !a } data While a = While { whileCondition :: !a, whileBody :: !a }
deriving (Eq, Show) deriving (Eq, Generic1, Show)
instance Eq1 While where liftEq = genericLiftEq
data DoWhile a = DoWhile { doWhileCondition :: !a, doWhileBody :: !a } data DoWhile a = DoWhile { doWhileCondition :: !a, doWhileBody :: !a }
deriving (Eq, Show) deriving (Eq, Generic1, Show)
instance Eq1 DoWhile where liftEq = genericLiftEq
-- Exception handling -- Exception handling
newtype Throw a = Throw a newtype Throw a = Throw a
deriving (Eq, Show) deriving (Eq, Generic1, Show)
instance Eq1 Throw where liftEq = genericLiftEq
data Try with a = Try !a ![with a] data Try with a = Try !a ![with a]
deriving instance (Eq a, Eq (with a)) => Eq (Try with a) deriving (Eq, Generic1, Show)
deriving instance (Show a, Show (with a)) => Show (Try with a) -- deriving instance (Eq a, Eq (with a)) => Eq (Try with a)
-- deriving instance (Show a, Show (with a)) => Show (Try with a)
instance Eq1 with => Eq1 (Try with) where liftEq = genericLiftEq
data Catch a = Catch !(Maybe a) !a data Catch a = Catch !(Maybe a) !a
deriving (Eq, Show) deriving (Eq, Generic1, Show)
instance Eq1 Catch where liftEq = genericLiftEq
newtype Finally a = Finally a newtype Finally a = Finally a
deriving (Eq, Show) deriving (Eq, Generic1, Show)
instance Eq1 Finally where liftEq = genericLiftEq