Commit 8645929f authored by Jan Rasmus Tikovsky 's avatar Jan Rasmus Tikovsky

Moved module InterfaceEquivalence to curry-base

parent 29213742
......@@ -4,6 +4,9 @@ Change log for curry-frontend
Under development
=================
* Moved module `InterfaceEquivalence` to curry-base
(`Curry.Syntax.InterfaceEquivalence`)
* Converted literate Haskell files into simple Haskell files
* Removed support for FlatCurry XML files.
......
......@@ -76,7 +76,6 @@ Executable cymake
, IL.Pretty
, IL.Type
, Imports
, InterfaceEquivalence
, Interfaces
, Modules
, ModuleSummary
......
{- |
Module : $Header$
Description : Comparison of Interfaces
Copyright : (c) 2000 - 2007, Wolfgang Lux
2014 , Björn Peemöller
License : OtherLicense
Maintainer : bjp@informatik.uni-kiel.de
Stability : experimental
Portability : portable
If a module is recompiled, the compiler has to check whether the
interface file must be updated. This must be done if any exported
entity has been changed, or an export was removed or added. The
function 'intfEquiv' checks whether two interfaces are
equivalent, i.e., whether they define the same entities.
/Note: There is deliberately no list instance for
'IntfEquiv' because the order of interface declarations is
irrelevant, whereas it is decisive for the constructor declarations
of a data type. By not providing a list instance, we cannot
inadvertently mix up these cases.
-}
module InterfaceEquivalence (fixInterface, intfEquiv) where
import Data.List (deleteFirstsBy)
import qualified Data.Set as Set
import Curry.Base.Ident
import Curry.Syntax
infix 4 =~=, `eqvList`, `eqvSet`
intfEquiv :: Interface -> Interface -> Bool
intfEquiv = (=~=)
class IntfEquiv a where
(=~=) :: a -> a -> Bool
eqvList :: IntfEquiv a => [a] -> [a] -> Bool
xs `eqvList` ys = length xs == length ys && and (zipWith (=~=) xs ys)
eqvSet :: IntfEquiv a => [a] -> [a] -> Bool
xs `eqvSet` ys = null (deleteFirstsBy (=~=) xs ys ++ deleteFirstsBy (=~=) ys xs)
instance IntfEquiv a => IntfEquiv (Maybe a) where
Nothing =~= Nothing = True
Nothing =~= Just _ = False
Just _ =~= Nothing = False
Just x =~= Just y = x =~= y
instance IntfEquiv Interface where
Interface m1 is1 ds1 =~= Interface m2 is2 ds2 =
m1 == m2 && is1 `eqvSet` is2 && ds1 `eqvSet` ds2
instance IntfEquiv IImportDecl where
IImportDecl _ m1 =~= IImportDecl _ m2 = m1 == m2
instance IntfEquiv IDecl where
IInfixDecl _ fix1 p1 op1 =~= IInfixDecl _ fix2 p2 op2 =
fix1 == fix2 && p1 == p2 && op1 == op2
HidingDataDecl _ tc1 tvs1 =~= HidingDataDecl _ tc2 tvs2 =
tc1 == tc2 && tvs1 == tvs2
IDataDecl _ tc1 tvs1 cs1 =~= IDataDecl _ tc2 tvs2 cs2 =
tc1 == tc2 && tvs1 == tvs2 && cs1 `eqvList` cs2
INewtypeDecl _ tc1 tvs1 nc1 =~= INewtypeDecl _ tc2 tvs2 nc2 =
tc1 == tc2 && tvs1 == tvs2 && nc1 =~= nc2
ITypeDecl _ tc1 tvs1 ty1 =~= ITypeDecl _ tc2 tvs2 ty2 =
tc1 == tc2 && tvs1 == tvs2 && ty1 == ty2
IFunctionDecl _ f1 n1 ty1 =~= IFunctionDecl _ f2 n2 ty2 =
f1 == f2 && n1 == n2 && ty1 == ty2
_ =~= _ = False
instance IntfEquiv ConstrDecl where
ConstrDecl _ evs1 c1 tys1 =~= ConstrDecl _ evs2 c2 tys2 =
c1 == c2 && evs1 == evs2 && tys1 == tys2
ConOpDecl _ evs1 ty11 op1 ty12 =~= ConOpDecl _ evs2 ty21 op2 ty22 =
op1 == op2 && evs1 == evs2 && ty11 == ty21 && ty12 == ty22
_ =~= _ = False
instance IntfEquiv NewConstrDecl where
NewConstrDecl _ evs1 c1 ty1 =~= NewConstrDecl _ evs2 c2 ty2 =
c1 == c2 && evs1 == evs2 && ty1 == ty2
-- If we check for a change in the interface, we do not need to check the
-- interface declarations, but still must disambiguate (nullary) type
-- constructors and type variables in type expressions. This is handled
-- by function 'fixInterface' and the associated type class 'FixInterface'.
fixInterface :: Interface -> Interface
fixInterface (Interface m is ds) = Interface m is $
fix (Set.fromList (typeConstructors ds)) ds
class FixInterface a where
fix :: Set.Set Ident -> a -> a
instance FixInterface a => FixInterface (Maybe a) where
fix tcs = fmap (fix tcs)
instance FixInterface a => FixInterface [a] where
fix tcs = map (fix tcs)
instance FixInterface IDecl where
fix tcs (IDataDecl p tc tvs cs) = IDataDecl p tc tvs (fix tcs cs)
fix tcs (INewtypeDecl p tc tvs nc) = INewtypeDecl p tc tvs (fix tcs nc)
fix tcs (ITypeDecl p tc tvs ty) = ITypeDecl p tc tvs (fix tcs ty)
fix tcs (IFunctionDecl p f n ty) = IFunctionDecl p f n (fix tcs ty)
fix _ d = d
instance FixInterface ConstrDecl where
fix tcs (ConstrDecl p evs c tys) = ConstrDecl p evs c (fix tcs tys)
fix tcs (ConOpDecl p evs ty1 op ty2) =
ConOpDecl p evs (fix tcs ty1) op (fix tcs ty2)
instance FixInterface NewConstrDecl where
fix tcs (NewConstrDecl p evs c ty) = NewConstrDecl p evs c (fix tcs ty)
instance FixInterface TypeExpr where
fix tcs (ConstructorType tc tys)
| not (isQualified tc) && not (isPrimTypeId tc) &&
tc' `Set.notMember` tcs && null tys
= VariableType tc'
| otherwise = ConstructorType tc (fix tcs tys)
where tc' = unqualify tc
fix tcs (VariableType tv)
| tv `Set.member` tcs = ConstructorType (qualify tv) []
| otherwise = VariableType tv
fix tcs (TupleType tys) = TupleType (fix tcs tys)
fix tcs (ListType ty) = ListType (fix tcs ty)
fix tcs (ArrowType ty1 ty2) = ArrowType (fix tcs ty1) (fix tcs ty2)
fix tcs (RecordType fs mty) = RecordType (map fixField fs) (fix tcs mty)
where fixField (lbl, ty) = (lbl, fix tcs ty)
typeConstructors :: [IDecl] -> [Ident]
typeConstructors ds = [tc | (QualIdent Nothing tc) <- foldr tyCons [] ds]
where tyCons (IInfixDecl _ _ _ _) tcs = tcs
tyCons (HidingDataDecl _ tc _) tcs = tc : tcs
tyCons (IDataDecl _ tc _ _) tcs = tc : tcs
tyCons (INewtypeDecl _ tc _ _) tcs = tc : tcs
tyCons (ITypeDecl _ tc _ _) tcs = tc : tcs
tyCons (IFunctionDecl _ _ _ _) tcs = tcs
isPrimTypeId :: QualIdent -> Bool
isPrimTypeId tc = tc `elem` [qUnitId, qListId] || isQTupleId tc
......@@ -35,9 +35,10 @@ import Curry.Base.Ident
import Curry.Base.Message (runMsg)
import Curry.Base.Position
import Curry.Base.Pretty
import Curry.ExtendedFlat.InterfaceEquality (eqInterface)
import Curry.ExtendedFlat.InterfaceEquivalence (eqInterface)
import Curry.Files.Filenames
import Curry.Files.PathUtils
import Curry.Syntax.InterfaceEquivalence
import Base.Messages
import Env.Interface
......@@ -54,7 +55,6 @@ import CompilerOpts
import Exports
import Generators
import Imports
import InterfaceEquivalence
import Interfaces
import ModuleSummary
import Transformations
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment