{- |
    Module      :  $Header$
    Description :  Check the equality of two FlatCurry interfaces
    Copyright   :  (c) 2006       , Martin Engelke
                       2011 - 2014, Björn Peemöller
                       2014       , Jan Tikovsky
    License     :  BSD-3-clause

    Maintainer  :  bjp@informatik.uni-kiel.de
    Stability   :  experimental
    Portability :  portable
-}

module Curry.FlatCurry.InterfaceEquivalence (eqInterface) where

import Data.List (deleteFirstsBy)

import Curry.FlatCurry.Type

infix 4 =~=, `eqvSet`

-- |Check whether the interfaces of two FlatCurry programs are equivalent.
eqInterface :: Prog -> Prog -> Bool
eqInterface :: Prog -> Prog -> Bool
eqInterface = Prog -> Prog -> Bool
forall a. Equiv a => a -> a -> Bool
(=~=)

-- |Type class to express the equivalence of two values
class Equiv a where
  (=~=) :: a -> a -> Bool

instance Equiv a => Equiv [a] where
  []     =~= :: [a] -> [a] -> Bool
=~= []     = Bool
True
  (x :: a
x:xs :: [a]
xs) =~= (y :: a
y:ys :: [a]
ys) = a
x a -> a -> Bool
forall a. Equiv a => a -> a -> Bool
=~= a
y Bool -> Bool -> Bool
&& [a]
xs [a] -> [a] -> Bool
forall a. Equiv a => a -> a -> Bool
=~= [a]
ys
  _      =~= _      = Bool
False

instance Equiv Char where =~= :: Char -> Char -> Bool
(=~=) = Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- |Equivalence of lists independent of the order.
eqvSet :: Equiv a => [a] -> [a] -> Bool
xs :: [a]
xs eqvSet :: [a] -> [a] -> Bool
`eqvSet` ys :: [a]
ys = [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ((a -> a -> Bool) -> [a] -> [a] -> [a]
forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
deleteFirstsBy a -> a -> Bool
forall a. Equiv a => a -> a -> Bool
(=~=) [a]
xs [a]
ys [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ (a -> a -> Bool) -> [a] -> [a] -> [a]
forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
deleteFirstsBy a -> a -> Bool
forall a. Equiv a => a -> a -> Bool
(=~=) [a]
ys [a]
xs)

instance Equiv Prog where
  Prog m1 :: String
m1 is1 :: [String]
is1 ts1 :: [TypeDecl]
ts1 fs1 :: [FuncDecl]
fs1 os1 :: [OpDecl]
os1 =~= :: Prog -> Prog -> Bool
=~= Prog m2 :: String
m2 is2 :: [String]
is2 ts2 :: [TypeDecl]
ts2 fs2 :: [FuncDecl]
fs2 os2 :: [OpDecl]
os2
    = String
m1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
m2 Bool -> Bool -> Bool
&& [String]
is1 [String] -> [String] -> Bool
forall a. Equiv a => [a] -> [a] -> Bool
`eqvSet` [String]
is2 Bool -> Bool -> Bool
&& [TypeDecl]
ts1 [TypeDecl] -> [TypeDecl] -> Bool
forall a. Equiv a => [a] -> [a] -> Bool
`eqvSet` [TypeDecl]
ts2
               Bool -> Bool -> Bool
&& [FuncDecl]
fs1 [FuncDecl] -> [FuncDecl] -> Bool
forall a. Equiv a => [a] -> [a] -> Bool
`eqvSet` [FuncDecl]
fs2 Bool -> Bool -> Bool
&& [OpDecl]
os1 [OpDecl] -> [OpDecl] -> Bool
forall a. Equiv a => [a] -> [a] -> Bool
`eqvSet` [OpDecl]
os2

instance Equiv TypeDecl where =~= :: TypeDecl -> TypeDecl -> Bool
(=~=) = TypeDecl -> TypeDecl -> Bool
forall a. Eq a => a -> a -> Bool
(==)

instance Equiv FuncDecl where
  Func qn1 :: QName
qn1 ar1 :: Int
ar1 vis1 :: Visibility
vis1 ty1 :: TypeExpr
ty1 r1 :: Rule
r1 =~= :: FuncDecl -> FuncDecl -> Bool
=~= Func qn2 :: QName
qn2 ar2 :: Int
ar2 vis2 :: Visibility
vis2 ty2 :: TypeExpr
ty2 r2 :: Rule
r2
    = QName
qn1 QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
== QName
qn2 Bool -> Bool -> Bool
&& Int
ar1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ar2 Bool -> Bool -> Bool
&& Visibility
vis1 Visibility -> Visibility -> Bool
forall a. Eq a => a -> a -> Bool
== Visibility
vis2 Bool -> Bool -> Bool
&& TypeExpr
ty1 TypeExpr -> TypeExpr -> Bool
forall a. Eq a => a -> a -> Bool
== TypeExpr
ty2 Bool -> Bool -> Bool
&& Rule
r1 Rule -> Rule -> Bool
forall a. Equiv a => a -> a -> Bool
=~= Rule
r2

-- TODO: Check why arguments of rules are not checked for equivalence
instance Equiv Rule where
  Rule _ _   =~= :: Rule -> Rule -> Bool
=~= Rule _ _   = Bool
True
  External _ =~= External _ = Bool
True
  _          =~= _          = Bool
False

instance Equiv OpDecl where =~= :: OpDecl -> OpDecl -> Bool
(=~=) = OpDecl -> OpDecl -> Bool
forall a. Eq a => a -> a -> Bool
(==)