Commit fbcd808e authored by Björn Peemöller 's avatar Björn Peemöller
Browse files

Added interface equivalence

parent f2cf49ec
% -*- LaTeX -*-
% $Id: IntfEquiv.lhs 2148 2007-04-02 13:56:20Z wlux $
%
% Copyright (c) 2000-2007, Wolfgang Lux
% See LICENSE for the full license.
%
\nwfilename{IntfEquiv.lhs}
\section{Comparing Module Interfaces}
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 \texttt{intfEquiv} checks whether two interfaces are
equivalent, i.e., whether they define the same entities.
\textbf{Note:} There is deliberately no list instance for
\texttt{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.
\begin{verbatim}
> module InterfaceEquivalence (fixInterface, intfEquiv) where
> import Data.List (deleteFirstsBy)
> import qualified Data.Set as Set
> import Curry.Base.Ident
> import Curry.Syntax
import Base
import List
import Set
> 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
\end{verbatim}
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 \texttt{fixInterface} and the associated type class
\texttt{FixInterface}.
\begin{verbatim}
> 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
\end{verbatim}
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