% $Id: Base.lhs,v 1.77 2004/02/15 22:10:25 wlux Exp $ % % Copyright (c) 1999-2004, Wolfgang Lux % See LICENSE for the full license. % % Modified by Martin Engelke (men@informatik.uni-kiel.de) % \nwfilename{Base.lhs} \section{Common Definitions for the Compiler} The module \texttt{Base} provides common definitions for the various phases of the compiler. \begin{verbatim} > module Base(module Base,module Ident,module Position,module Types, > module CurrySyntax) where > import Data.List > import Control.Monad > import Data.Maybe > import Ident > import Position > import Types > import CurrySyntax > import CurryPP > import Pretty > import ExtendedFlat hiding (SrcRef, Fixity(..), TypeExpr, Expr(..)) > import Env > import TopEnv > import Map > import Set > import Utils > import qualified ExtendedFlat as EF \end{verbatim} \paragraph{Types} The functions \texttt{toType}, \texttt{toTypes}, and \texttt{fromType} convert Curry type expressions into types and vice versa. The functions \texttt{qualifyType} and \texttt{unqualifyType} add and remove module qualifiers in a type, respectively. When Curry type expression are converted with \texttt{toType} or \texttt{toTypes}, type variables are assigned ascending indices in the order of their occurrence. It is possible to pass a list of additional type variables to both functions which are assigned indices before those variables occurring in the type. This allows preserving the order of type variables in the left hand side of a type declaration. \begin{verbatim} > toQualType :: ModuleIdent -> [Ident] -> TypeExpr -> Type > toQualType m tvs ty = qualifyType m (toType tvs ty) > toQualTypes :: ModuleIdent -> [Ident] -> [TypeExpr] -> [Type] > toQualTypes m tvs tys = map (qualifyType m) (toTypes tvs tys) > toType :: [Ident] -> TypeExpr -> Type > toType tvs ty = toType' (fromListFM (zip (tvs ++ tvs') [0..])) ty > where tvs' = [tv | tv <- nub (fv ty), tv `notElem` tvs] > toTypes :: [Ident] -> [TypeExpr] -> [Type] > toTypes tvs tys = map (toType' (fromListFM (zip (tvs ++ tvs') [0..]))) tys > where tvs' = [tv | tv <- nub (concatMap fv tys), tv `notElem` tvs] > toType' :: FM Ident Int -> TypeExpr -> Type > toType' tvs (ConstructorType tc tys) = > TypeConstructor tc (map (toType' tvs) tys) > toType' tvs (VariableType tv) = > maybe (internalError ("toType " ++ show tv)) TypeVariable (lookupFM tv tvs) > toType' tvs (TupleType tys) > | null tys = TypeConstructor (qualify unitId) [] > | otherwise = TypeConstructor (qualify (tupleId (length tys'))) tys' > where tys' = map (toType' tvs) tys > toType' tvs (ListType ty) = TypeConstructor (qualify listId) [toType' tvs ty] > toType' tvs (ArrowType ty1 ty2) = > TypeArrow (toType' tvs ty1) (toType' tvs ty2) > toType' tvs (RecordType fs rty) = > TypeRecord (concatMap (\ (ls,ty) -> map (\l -> (l, toType' tvs ty)) ls) fs) > (maybe Nothing > (\ty -> case toType' tvs ty of > TypeVariable tv -> Just tv > _ -> internalError ("toType " ++ show ty)) > rty) > qualifyType :: ModuleIdent -> Type -> Type > qualifyType m (TypeConstructor tc tys) > | isTupleId tc' = tupleType tys' > | tc' == unitId && n == 0 = unitType > | tc' == listId && n == 1 = listType (head tys') > | otherwise = TypeConstructor (qualQualify m tc) tys' > where n = length tys' > tc' = unqualify tc > tys' = map (qualifyType m) tys > qualifyType _ (TypeVariable tv) = TypeVariable tv > qualifyType m (TypeConstrained tys tv) = > TypeConstrained (map (qualifyType m) tys) tv > qualifyType m (TypeArrow ty1 ty2) = > TypeArrow (qualifyType m ty1) (qualifyType m ty2) > qualifyType _ (TypeSkolem k) = TypeSkolem k > qualifyType m (TypeRecord fs rty) = > TypeRecord (map (\ (l,ty) -> (l, qualifyType m ty)) fs) rty > fromQualType :: ModuleIdent -> Type -> TypeExpr > fromQualType m ty = fromType (unqualifyType m ty) > fromType :: Type -> TypeExpr > fromType (TypeConstructor tc tys) > | isTupleId c = TupleType tys' > | c == listId && length tys == 1 = ListType (head tys') > | c == unitId && null tys = TupleType [] > | otherwise = ConstructorType tc tys' > where c = unqualify tc > tys' = map (fromType) tys > fromType (TypeVariable tv) = > VariableType (if tv >= 0 then nameSupply !! tv > else mkIdent ('_' : show (-tv))) > fromType (TypeConstrained tys _) = fromType (head tys) > fromType (TypeArrow ty1 ty2) = ArrowType (fromType ty1) (fromType ty2) > fromType (TypeSkolem k) = VariableType (mkIdent ("_?" ++ show k)) > fromType (TypeRecord fs rty) = > RecordType (map (\ (l,ty) -> ([l], fromType ty)) fs) > (maybe Nothing (Just . fromType . TypeVariable) rty) > unqualifyType :: ModuleIdent -> Type -> Type > unqualifyType m (TypeConstructor tc tys) = > TypeConstructor (qualUnqualify m tc) (map (unqualifyType m) tys) > unqualifyType _ (TypeVariable tv) = TypeVariable tv > unqualifyType m (TypeConstrained tys tv) = > TypeConstrained (map (unqualifyType m) tys) tv > unqualifyType m (TypeArrow ty1 ty2) = > TypeArrow (unqualifyType m ty1) (unqualifyType m ty2) > unqualifyType m (TypeSkolem k) = TypeSkolem k > unqualifyType m (TypeRecord fs rty) = > TypeRecord (map (\ (l,ty) -> (l, unqualifyType m ty)) fs) rty \end{verbatim} The following functions implement pretty-printing for types. \begin{verbatim} > ppType :: ModuleIdent -> Type -> Doc > ppType m = ppTypeExpr 0 . fromQualType m > ppTypeScheme :: ModuleIdent -> TypeScheme -> Doc > ppTypeScheme m (ForAll _ ty) = ppType m ty \end{verbatim} \paragraph{Interfaces} The compiler maintains a global environment holding all (directly or indirectly) imported interfaces. The function \texttt{bindFlatInterfac} transforms FlatInterface information (type \texttt{FlatCurry.Prog} to MCC interface declarations (type \texttt{CurrySyntax.IDecl}. This is necessary to process FlatInterfaces instead of ".icurry" files when using MCC as frontend for PAKCS. \begin{verbatim} > type ModuleEnv = Env ModuleIdent [IDecl] > bindModule :: Interface -> ModuleEnv -> ModuleEnv > bindModule (Interface m ds) = bindEnv m ds > bindFlatInterface :: Prog -> ModuleEnv -> ModuleEnv > bindFlatInterface (Prog m imps ts fs os) > = bindModule (Interface (mkMIdent [m]) > ((map genIImportDecl imps) > ++ (map genITypeDecl ts') > ++ (map genIFuncDecl fs) > ++ (map genIOpDecl os))) > where > genIImportDecl :: String -> IDecl > genIImportDecl imp = IImportDecl pos (mkMIdent [imp]) > > genITypeDecl :: TypeDecl -> IDecl > genITypeDecl (Type qn _ is cs) > | recordExt `isPrefixOf` localName qn > = ITypeDecl pos > (genQualIdent qn) > (map (genVarIndexIdent "a") is) > (RecordType (map genLabeledType cs) Nothing) > | otherwise > = IDataDecl pos > (genQualIdent qn) > (map (genVarIndexIdent "a") is) > (map (Just . genConstrDecl) cs) > genITypeDecl (TypeSyn qn _ is t) > = ITypeDecl pos > (genQualIdent qn) > (map (genVarIndexIdent "a") is) > (genTypeExpr t) > > genIFuncDecl :: FuncDecl -> IDecl > genIFuncDecl (Func qn a _ t _) > = IFunctionDecl pos (genQualIdent qn) a (genTypeExpr t) > > genIOpDecl :: OpDecl -> IDecl > genIOpDecl (Op qn f p) = IInfixDecl pos (genInfix f) p (genQualIdent qn) > > genConstrDecl :: ConsDecl -> ConstrDecl > genConstrDecl (Cons qn _ _ ts) > = ConstrDecl pos [] (mkIdent (localName qn)) (map genTypeExpr ts) > > genLabeledType :: EF.ConsDecl -> ([Ident],CurrySyntax.TypeExpr) > genLabeledType (Cons qn _ _ [t]) > = ([renameLabel (fromLabelExtId (mkIdent $ localName qn))], genTypeExpr t) > > genTypeExpr :: EF.TypeExpr -> CurrySyntax.TypeExpr > genTypeExpr (TVar i) > = VariableType (genVarIndexIdent "a" i) > genTypeExpr (FuncType t1 t2) > = ArrowType (genTypeExpr t1) (genTypeExpr t2) > genTypeExpr (TCons qn ts) > = ConstructorType (genQualIdent qn) (map genTypeExpr ts) > > genInfix :: EF.Fixity -> Infix > genInfix EF.InfixOp = Infix > genInfix EF.InfixlOp = InfixL > genInfix EF.InfixrOp = InfixR > > genQualIdent :: QName -> QualIdent > genQualIdent QName{modName=mod,localName=name} = > qualifyWith (mkMIdent [mod]) (mkIdent name) > > genVarIndexIdent :: String -> Int -> Ident > genVarIndexIdent v i = mkIdent (v ++ show i) > > isSpecialPreludeType :: TypeDecl -> Bool > isSpecialPreludeType (Type QName{modName=mod,localName=name} _ _ _) > = (name == "[]" || name == "()") && mod == "Prelude" > isSpecialPreludeType _ = False > > pos = first m > ts' = filter (not . isSpecialPreludeType) ts > lookupModule :: ModuleIdent -> ModuleEnv -> Maybe [IDecl] > lookupModule = lookupEnv \end{verbatim} The label environment is used to store information of labels. Unlike unsual identifiers like in functions, types etc. identifiers of labels are always represented unqualified. Since the common type environment (type \texttt{ValueEnv}) has some problems with handling imported unqualified identifiers, it is necessary to process the type information for labels seperately. \begin{verbatim} > data LabelInfo = LabelType Ident QualIdent Type deriving Show > type LabelEnv = Env Ident [LabelInfo] > bindLabelType :: Ident -> QualIdent -> Type -> LabelEnv -> LabelEnv > bindLabelType l r ty lEnv = > maybe (bindEnv l [LabelType l r ty] lEnv) > (\ls -> bindEnv l ((LabelType l r ty):ls) lEnv) > (lookupEnv l lEnv) > lookupLabelType :: Ident -> LabelEnv -> [LabelInfo] > lookupLabelType l lEnv = fromMaybe [] (lookupEnv l lEnv) > initLabelEnv :: LabelEnv > initLabelEnv = emptyEnv \end{verbatim} \paragraph{Type constructors} For all defined types the compiler must maintain kind information. At present, Curry does not support type classes. Therefore its type language is first order and the only information that must be recorded is the arity of each type. For algebraic data types and renaming types the compiler also records all data constructors belonging to that type, for alias types the type expression to be expanded is saved. In order to manage the import and export of types, the names of the original definitions are also recorded. On import two types are considered equal if their original names match. The information for a data constructor comprises the number of existentially quantified type variables and the list of the argument types. Note that renaming type constructors have only one type argument. Importing and exporting algebraic data types and renaming types is complicated by the fact that the constructors of the type may be (partially) hidden in the interface. This facilitates the definition of abstract data types. An abstract type is always represented as a data type without constructors in the interface regardless of whether it is defined as a data type or as a renaming type. When only some constructors of a data type are hidden, those constructors are replaced by underscores in the interface. Furthermore, if the right-most constructors of a data type are hidden, they are not exported at all in order to make the interface more stable against changes which are private to the module. \begin{verbatim} > data TypeInfo = DataType QualIdent Int [Maybe (Data [Type])] > | RenamingType QualIdent Int (Data Type) > | AliasType QualIdent Int Type > deriving Show > data Data a = Data Ident Int a deriving Show > instance Entity TypeInfo where > origName (DataType tc _ _) = tc > origName (RenamingType tc _ _) = tc > origName (AliasType tc _ _) = tc > merge (DataType tc n cs) (DataType tc' _ cs') > | tc == tc' = Just (DataType tc n (mergeData cs cs')) > where mergeData ds [] = ds > mergeData [] ds = ds > mergeData (d:ds) (d':ds') = d `mplus` d' : mergeData ds ds' > merge (DataType tc n _) (RenamingType tc' _ nc) > | tc == tc' = Just (RenamingType tc n nc) > merge (RenamingType tc n nc) (DataType tc' _ _) > | tc == tc' = Just (RenamingType tc n nc) > merge (RenamingType tc n nc) (RenamingType tc' _ _) > | tc == tc' = Just (RenamingType tc n nc) > merge (AliasType tc n ty) (AliasType tc' _ _) > | tc == tc' = Just (AliasType tc n ty) > merge _ _ = Nothing > tcArity :: TypeInfo -> Int > tcArity (DataType _ n _) = n > tcArity (RenamingType _ n _) = n > tcArity (AliasType _ n _) = n \end{verbatim} Types can only be defined on the top-level; no nested environments are needed for them. Tuple types must be handled as a special case because there is an infinite number of potential tuple types making it impossible to insert them into the environment in advance. \begin{verbatim} > type TCEnv = TopEnv TypeInfo > bindTypeInfo :: (QualIdent -> Int -> a -> TypeInfo) -> ModuleIdent > -> Ident -> [Ident] -> a -> TCEnv -> TCEnv > bindTypeInfo f m tc tvs x > = bindTopEnv "Base.bindTypeInfo" tc t > . qualBindTopEnv "Base.bindTypeInfo" tc' t > where tc' = qualifyWith m tc > t = f tc' (length tvs) x > lookupTC :: Ident -> TCEnv -> [TypeInfo] > lookupTC tc tcEnv = lookupTopEnv tc tcEnv ++! lookupTupleTC tc > qualLookupTC :: QualIdent -> TCEnv -> [TypeInfo] > qualLookupTC tc tcEnv = > qualLookupTopEnv tc tcEnv ++! lookupTupleTC (unqualify tc) > lookupTupleTC :: Ident -> [TypeInfo] > lookupTupleTC tc > | isTupleId tc = [tupleTCs !! (tupleArity tc - 2)] > | otherwise = [] > tupleTCs :: [TypeInfo] > tupleTCs = map typeInfo tupleData > where typeInfo (Data c _ tys) = > DataType (qualifyWith preludeMIdent c) (length tys) > [Just (Data c 0 tys)] > tupleData :: [Data [Type]] > tupleData = [Data (tupleId n) 0 (take n tvs) | n <- [2..]] > where tvs = map typeVar [0..] \end{verbatim} \paragraph{Function and constructor types} In order to test the type correctness of a module, the compiler needs to determine the type of every data constructor, function, variable, record and label in the module. For the purpose of type checking there is no need for distinguishing between variables and functions. For all objects their original names and their types are saved. Functions also contain arity information. Labels currently contain the name of their defining record. On import two values are considered equal if their original names match. \begin{verbatim} > data ValueInfo = DataConstructor QualIdent ExistTypeScheme > | NewtypeConstructor QualIdent ExistTypeScheme > | Value QualIdent TypeScheme > | Label QualIdent QualIdent TypeScheme > -- Label