Refactorings and improved dumps (now with environments)

curry-frontend.cabal

@@ -67,7 +67,7 @@ Executable cymake
     , Env.Interface
     , Env.ModuleAlias
     , Env.OpPrec
-    , Env.TypeConstructors
+    , Env.TypeConstructor
     , Env.Value
     , Exports
     , Frontend

src/Checks/ExportCheck.hs

@@ -17,7 +17,7 @@ import Base.Types
 import Base.Utils (findMultiples)
 
 import Env.ModuleAlias
-import Env.TypeConstructors
+import Env.TypeConstructor
 import Env.Value
 
 -- ---------------------------------------------------------------------------

src/Checks/KindCheck.lhs

@@ -36,7 +36,7 @@ is defined more than once.
 > import Base.TopEnv
 > import Base.Utils (findMultiples)
 
-> import Env.TypeConstructors (TCEnv, tcArity)
+> import Env.TypeConstructor (TCEnv, tcArity)
 
 \end{verbatim}
 In order to check type constructor applications, the compiler

src/Checks/SyntaxCheck.lhs

@@ -38,7 +38,7 @@ merged into a single definition.
 > import Base.Types
 > import Base.Utils ((++!), findDouble, findMultiples)
 
-> import Env.TypeConstructors (TCEnv, TypeInfo (..), qualLookupTC)
+> import Env.TypeConstructor (TCEnv, TypeInfo (..), qualLookupTC)
 > import Env.Value (ValueEnv, ValueInfo (..))
 
 > import CompilerOpts

src/Checks/TypeCheck.lhs

@@ -45,7 +45,7 @@ type annotation is present.
 > import Base.TypeSubst
 > import Base.Utils (foldr2)
 
-> import Env.TypeConstructors (TCEnv, TypeInfo (..), bindTypeInfo
+> import Env.TypeConstructor (TCEnv, TypeInfo (..), bindTypeInfo
 >   , qualLookupTC)
 > import Env.Value ( ValueEnv, ValueInfo (..), bindFun, rebindFun
 >   , bindGlobalInfo, bindLabel, lookupValue, qualLookupValue )

src/CompilerEnv.hs

@@ -13,13 +13,17 @@
 -}
 module CompilerEnv where
 
+import qualified Data.Map as Map (keys)
+
 import Curry.Base.Ident (ModuleIdent)
 
+import Base.TopEnv (localBindings)
+
 import Env.Eval
 import Env.Interface
 import Env.ModuleAlias
 import Env.OpPrec
-import Env.TypeConstructors
+import Env.TypeConstructor
 import Env.Value
 
 -- |A compiler environment contains information about the module currently
@@ -33,7 +37,7 @@ data CompilerEnv = CompilerEnv
   , valueEnv     :: ValueEnv     -- ^ functions and data constructors
   , opPrecEnv    :: PEnv         -- ^ operator precedences
   , evalAnnotEnv :: EvalEnv      -- ^ evaluation annotations
-  } deriving Show
+  }
 
 initCompilerEnv :: ModuleIdent -> CompilerEnv
 initCompilerEnv mid = CompilerEnv
@@ -45,3 +49,15 @@ initCompilerEnv mid = CompilerEnv
   , opPrecEnv    = initPEnv
   , evalAnnotEnv = initEEnv
   }
+
+showCompilerEnv :: CompilerEnv -> String
+showCompilerEnv env = unlines $ concat
+  [ header "ModuleIdent"      $ show $ moduleIdent  env
+  , header "Interfaces"       $ show $ Map.keys      $ interfaceEnv env
+  , header "ModuleAliases"    $ show $ aliasEnv     env
+  , header "TypeConstructors" $ show $ localBindings $ tyConsEnv env
+  , header "Values"           $ show $ localBindings $ valueEnv  env
+  , header "Precedences"      $ show $ localBindings $ opPrecEnv env
+  , header "Eval Annotations" $ show $ evalAnnotEnv env
+  ]
+  where header hdr content = [hdr, replicate (length hdr) '=', content]
\ No newline at end of file

src/CompilerOpts.hs

@@ -91,7 +91,6 @@ classifyVerbosity _   v = v
 -- |Data type for representing code dumps
 data DumpLevel
   = DumpRenamed      -- ^ dump source  after renaming
-  | DumpTypes        -- ^ dump types   after typechecking
   | DumpDesugared    -- ^ dump source  after desugaring
   | DumpSimplified   -- ^ dump source  after simplification
   | DumpLifted       -- ^ dump source  after lambda-lifting
@@ -210,9 +209,6 @@ options =
       (NoArg (\ opts -> opts { optDumps =
         nub $ DumpRenamed : optDumps opts }))
       "dump source code after renaming"
-  , Option ""   ["dump-types"]
-      (NoArg (\ opts -> opts { optDumps = nub $ DumpTypes : optDumps opts }))
-      "dump types after type-checking"
   , Option ""   ["dump-desugared"]
       (NoArg (\ opts -> opts { optDumps =
         nub $ DumpDesugared : optDumps opts }))

src/Env/Eval.hs

+{- |
+    Module      :  $Header$
+    Description :  Environment of Evaluation Annotations
+    Copyright   :  (c) 2001-2004, Wolfgang Lux
+                       2011, Björn Peemöller   (bjp@informatik.uni-kiel.de)
+    License     :  OtherLicense
+
+    Maintainer  :  bjp@informatik.uni-kiel.de
+    Stability   :  experimental
+    Portability :  portable
+
+    This module computes the evaluation annotation environment. There is no
+    need to check the annotations because this happens already while checking
+    the definitions of the module.
+-}
+
+module Env.Eval (EvalEnv, initEEnv, evalEnv) where
+
+import qualified Data.Map as Map (Map, empty, insert)
+
+import Curry.Base.Ident (Ident)
+import Curry.Syntax
+
+type EvalEnv = Map.Map Ident EvalAnnotation
+
+initEEnv :: EvalEnv
+initEEnv = Map.empty
+
+-- |The function 'evalEnv' collects all evaluation annotations of
+-- the module by traversing the syntax tree.
+evalEnv :: Module -> EvalEnv
+evalEnv (Module _ _ _ ds) = foldr annDecl initEEnv ds
+
+annDecl :: Decl -> EvalEnv -> EvalEnv
+annDecl (EvalAnnot    _ fs ev) env = foldr (`Map.insert` ev) env fs
+annDecl (FunctionDecl _ _ eqs) env = foldr annEquation env eqs
+annDecl (PatternDecl  _ _ rhs) env = annRhs rhs env
+annDecl _                      env = env
+
+annEquation :: Equation -> EvalEnv -> EvalEnv
+annEquation (Equation _ _ rhs) = annRhs rhs
+
+annRhs :: Rhs -> EvalEnv -> EvalEnv
+annRhs (SimpleRhs _ e ds) env = annExpr e (foldr annDecl env ds)
+annRhs (GuardedRhs es ds) env = foldr annCondExpr (foldr annDecl env ds) es
+
+annCondExpr :: CondExpr -> EvalEnv -> EvalEnv
+annCondExpr (CondExpr _ g e) env = annExpr g (annExpr e env)
+
+annExpr :: Expression -> EvalEnv -> EvalEnv
+annExpr (Literal               _) env = env
+annExpr (Variable              _) env = env
+annExpr (Constructor           _) env = env
+annExpr (Paren                 e) env = annExpr e env
+annExpr (Typed               e _) env = annExpr e env
+annExpr (Tuple              _ es) env = foldr annExpr env es
+annExpr (List               _ es) env = foldr annExpr env es
+annExpr (ListCompr        _ e qs) env = annExpr e (foldr annStatement env qs)
+annExpr (EnumFrom              e) env = annExpr e env
+annExpr (EnumFromThen      e1 e2) env = annExpr e1 (annExpr e2 env)
+annExpr (EnumFromTo        e1 e2) env = annExpr e1 (annExpr e2 env)
+annExpr (EnumFromThenTo e1 e2 e3) env = annExpr e1 (annExpr e2 (annExpr e3 env))
+annExpr (UnaryMinus          _ e) env = annExpr e env
+annExpr (Apply             e1 e2) env = annExpr e1 (annExpr e2 env)
+annExpr (InfixApply      e1 _ e2) env = annExpr e1 (annExpr e2 env)
+annExpr (LeftSection         e _) env = annExpr e env
+annExpr (RightSection        _ e) env = annExpr e env
+annExpr (Lambda            _ _ e) env = annExpr e env
+annExpr (Let                ds e) env = foldr annDecl (annExpr e env) ds
+annExpr (Do                sts e) env = foldr annStatement (annExpr e env) sts
+annExpr (IfThenElse   _ e1 e2 e3) env = annExpr e1 (annExpr e2 (annExpr e3 env))
+annExpr (Case           _ e alts) env = annExpr e (foldr annAlt env alts)
+annExpr (RecordConstr         fs) env = foldr (annExpr . fieldTerm) env fs
+annExpr (RecordSelection     e _) env = annExpr e env
+annExpr (RecordUpdate       fs e) env = foldr (annExpr . fieldTerm) (annExpr e env) fs
+
+annStatement :: Statement -> EvalEnv -> EvalEnv
+annStatement (StmtExpr   _ e) env = annExpr e env
+annStatement (StmtDecl    ds) env = foldr annDecl env ds
+annStatement (StmtBind _ _ e) env = annExpr e env
+
+annAlt :: Alt -> EvalEnv -> EvalEnv
+annAlt (Alt _ _ rhs) = annRhs rhs

src/Env/Eval.lhs

-% $Id: Eval.lhs,v 1.12 2004/02/08 15:35:12 wlux Exp $
-%
-% Copyright (c) 2001-2004, Wolfgang Lux
-% See LICENSE for the full license.
-%
-\nwfilename{Eval.lhs}
-\section{Collecting Evaluation Annotations}
-The module \texttt{Eval} computes the evaluation annotation
-environment. There is no need to check the annotations because this
-happens already while checking the definitions of the module.
-\begin{verbatim}
-
-> module Env.Eval (EvalEnv, initEEnv, evalEnv) where
-
-> import qualified Data.Map as Map
-
-> import Curry.Base.Ident (Ident)
-> import Curry.Syntax
-
-> type EvalEnv = Map.Map Ident EvalAnnotation
-
-\end{verbatim}
-The function \texttt{evalEnv} collects all evaluation annotations of
-the module by traversing the syntax tree.
-\begin{verbatim}
-
-> initEEnv :: EvalEnv
-> initEEnv = Map.empty
-
-> evalEnv :: Module -> EvalEnv
-> evalEnv (Module _ _ _ ds) = foldr collectAnnotsDecl initEEnv ds
-
-> collectAnnotsDecl :: Decl -> EvalEnv -> EvalEnv
-> collectAnnotsDecl (EvalAnnot    _ fs ev) env = foldr (`Map.insert` ev) env fs
-> collectAnnotsDecl (FunctionDecl _ _ eqs) env = foldr collectAnnotsEqn env eqs
-> collectAnnotsDecl (PatternDecl  _ _ rhs) env = collectAnnotsRhs rhs env
-> collectAnnotsDecl _                      env = env
-
-> collectAnnotsEqn :: Equation -> EvalEnv -> EvalEnv
-> collectAnnotsEqn (Equation _ _ rhs) = collectAnnotsRhs rhs
-
-> collectAnnotsRhs :: Rhs -> EvalEnv -> EvalEnv
-> collectAnnotsRhs (SimpleRhs _ e ds) env =
->   collectAnnotsExpr e (foldr collectAnnotsDecl env ds)
-> collectAnnotsRhs (GuardedRhs es ds) env =
->   foldr collectAnnotsCondExpr (foldr collectAnnotsDecl env ds) es
-
-> collectAnnotsCondExpr :: CondExpr -> EvalEnv -> EvalEnv
-> collectAnnotsCondExpr (CondExpr _ g e) env =
->   collectAnnotsExpr g (collectAnnotsExpr e env)
-
-> collectAnnotsExpr :: Expression -> EvalEnv -> EvalEnv
-> collectAnnotsExpr (Literal _)        env = env
-> collectAnnotsExpr (Variable _)       env = env
-> collectAnnotsExpr (Constructor _)    env = env
-> collectAnnotsExpr (Paren e)          env = collectAnnotsExpr e env
-> collectAnnotsExpr (Typed e _)        env = collectAnnotsExpr e env
-> collectAnnotsExpr (Tuple _ es)       env = foldr collectAnnotsExpr env es
-> collectAnnotsExpr (List  _ es)       env = foldr collectAnnotsExpr env es
-> collectAnnotsExpr (ListCompr _ e qs) env =
->   collectAnnotsExpr e (foldr collectAnnotsStmt env qs)
-> collectAnnotsExpr (EnumFrom e)              env = collectAnnotsExpr e env
-> collectAnnotsExpr (EnumFromThen e1 e2)      env =
->   collectAnnotsExpr e1 (collectAnnotsExpr e2 env)
-> collectAnnotsExpr (EnumFromTo e1 e2)        env =
->   collectAnnotsExpr e1 (collectAnnotsExpr e2 env)
-> collectAnnotsExpr (EnumFromThenTo e1 e2 e3) env =
->   collectAnnotsExpr e1 (collectAnnotsExpr e2 (collectAnnotsExpr e3 env))
-> collectAnnotsExpr (UnaryMinus _ e)     env = collectAnnotsExpr e env
-> collectAnnotsExpr (Apply e1 e2)        env =
->   collectAnnotsExpr e1 (collectAnnotsExpr e2 env)
-> collectAnnotsExpr (InfixApply e1 _ e2) env =
->   collectAnnotsExpr e1 (collectAnnotsExpr e2 env)
-> collectAnnotsExpr (LeftSection e _)    env = collectAnnotsExpr e env
-> collectAnnotsExpr (RightSection _ e)   env = collectAnnotsExpr e env
-> collectAnnotsExpr (Lambda _ _ e)       env = collectAnnotsExpr e env
-> collectAnnotsExpr (Let ds e)           env =
->   foldr collectAnnotsDecl (collectAnnotsExpr e env) ds
-> collectAnnotsExpr (Do sts e)           env =
->   foldr collectAnnotsStmt (collectAnnotsExpr e env) sts
-> collectAnnotsExpr (IfThenElse _ e1 e2 e3) env =
->   collectAnnotsExpr e1 (collectAnnotsExpr e2 (collectAnnotsExpr e3 env))
-> collectAnnotsExpr (Case _ e alts)         env =
->   collectAnnotsExpr e (foldr collectAnnotsAlt env alts)
-> collectAnnotsExpr (RecordConstr fs)       env =
->   foldr (collectAnnotsExpr . fieldTerm) env fs
-> collectAnnotsExpr (RecordSelection e _)   env = collectAnnotsExpr e env
-> collectAnnotsExpr (RecordUpdate fs e)     env =
->   foldr (collectAnnotsExpr . fieldTerm) (collectAnnotsExpr e env) fs
-
-> collectAnnotsStmt :: Statement -> EvalEnv -> EvalEnv
-> collectAnnotsStmt (StmtExpr   _ e) env = collectAnnotsExpr e env
-> collectAnnotsStmt (StmtDecl    ds) env = foldr collectAnnotsDecl env ds
-> collectAnnotsStmt (StmtBind _ _ e) env = collectAnnotsExpr e env
-
-> collectAnnotsAlt :: Alt -> EvalEnv -> EvalEnv
-> collectAnnotsAlt (Alt _ _ rhs) = collectAnnotsRhs rhs
-
-\end{verbatim}

src/Env/OpPrec.hs

+{- |
+    Module      :  $Header$
+    Description :  Environment of Operator precedences
+    Copyright   :  (c) 2002-2004, Wolfgang Lux
+                       2011, Björn Peemöller   (bjp@informatik.uni-kiel.de)
+    License     :  OtherLicense
+
+    Maintainer  :  bjp@informatik.uni-kiel.de
+    Stability   :  experimental
+    Portability :  portable
+
+    In order to parse infix expressions correctly, the compiler must know
+    the precedence and fixity of each operator. Operator precedences are
+    associated with entities and will be checked after renaming was
+    applied. Nevertheless, we need to save precedences for ambiguous names
+    in order to handle them correctly while computing the exported
+    interface of a module.
+
+    If no fixity is assigned to an operator, it will be given the default
+    precedence 9 and assumed to be a left-associative operator.
+
+    \em{Note:} this modified version uses Haskell type \texttt{Integer}
+    for representing the precedence. This change had to be done due to the
+    introduction of unlimited integer constants in the parser / lexer.
+-}
+
+module Env.OpPrec
+  ( PEnv, PrecInfo (..), OpPrec (..), defaultP, bindP, lookupP, qualLookupP
+  , initPEnv ) where
+
+import Curry.Base.Ident
+import Curry.Syntax (Infix (..))
+
+import Base.TopEnv
+
+data OpPrec = OpPrec Infix Integer deriving Eq
+
+instance Show OpPrec where
+  showsPrec _ (OpPrec fix p) = showString (assoc fix) . shows p
+    where assoc InfixL = "left "
+          assoc InfixR = "right "
+          assoc Infix  = "non-assoc "
+
+defaultP :: OpPrec
+defaultP = OpPrec InfixL 9
+
+data PrecInfo = PrecInfo QualIdent OpPrec deriving (Eq, Show)
+
+instance Entity PrecInfo where
+  origName (PrecInfo op _) = op
+
+type PEnv = TopEnv PrecInfo
+
+bindP :: ModuleIdent -> Ident -> OpPrec -> PEnv -> PEnv
+bindP m op p
+  | uniqueId op == 0 = bindTopEnv fun op info . qualBindTopEnv fun qop info
+  | otherwise        = bindTopEnv fun op info
+  where qop  = qualifyWith m op
+        info = PrecInfo qop p
+        fun  = "Env.OpPrec.bindP"
+
+-- The lookup functions for the environment which maintains the operator
+-- precedences are simpler than for the type and value environments
+-- because they do not need to handle tuple constructors.
+
+lookupP :: Ident -> PEnv -> [PrecInfo]
+lookupP = lookupTopEnv
+
+qualLookupP :: QualIdent -> PEnv -> [PrecInfo]
+qualLookupP = qualLookupTopEnv
+
+initPEnv :: PEnv
+initPEnv = predefTopEnv qConsId consPrec emptyTopEnv
+
+consPrec :: PrecInfo
+consPrec = PrecInfo qConsId (OpPrec InfixR 5)

src/Env/OpPrec.lhs

-\paragraph{Operator precedences}
-In order to parse infix expressions correctly, the compiler must know
-the precedence and fixity of each operator. Operator precedences are
-associated with entities and will be checked after renaming was
-applied. Nevertheless, we need to save precedences for ambiguous names
-in order to handle them correctly while computing the exported
-interface of a module.
-
-If no fixity is assigned to an operator, it will be given the default
-precedence 9 and assumed to be a left-associative operator.
-
-\em{Note:} this modified version uses Haskell type \texttt{Integer}
-for representing the precedence. This change had to be done due to the
-introduction of unlimited integer constants in the parser / lexer.
-\begin{verbatim}
-
-> module Env.OpPrec
->   ( PEnv, PrecInfo (..), OpPrec (..), defaultP, bindP, lookupP, qualLookupP
->   , initPEnv ) where
-
-> import Curry.Base.Ident
-> import Curry.Syntax (Infix (..))
-
-> import Base.TopEnv
-
-> data OpPrec = OpPrec Infix Integer deriving Eq
-
-> instance Show OpPrec where
->   showsPrec _ (OpPrec fix p) = showString (assoc fix) . shows p
->     where assoc InfixL = "left "
->           assoc InfixR = "right "
->           assoc Infix  = "non-assoc "
-
-> defaultP :: OpPrec
-> defaultP = OpPrec InfixL 9
-
-\end{verbatim}
-The lookup functions for the environment which maintains the operator
-precedences are simpler than for the type and value environments
-because they do not need to handle tuple constructors.
-\begin{verbatim}
-
-> data PrecInfo = PrecInfo QualIdent OpPrec deriving (Eq, Show)
-
-> instance Entity PrecInfo where
->   origName (PrecInfo op _) = op
-
-> type PEnv = TopEnv PrecInfo
-
-> bindP :: ModuleIdent -> Ident -> OpPrec -> PEnv -> PEnv
-> bindP m op p
->   | uniqueId op == 0 = bindTopEnv     "Base.bindP" op  info
->                      . qualBindTopEnv "Base.bindP" qop info
->   | otherwise        = bindTopEnv     "Base.bindP" op  info
->   where qop  = qualifyWith m op
->         info = PrecInfo qop p
-
-> lookupP :: Ident -> PEnv -> [PrecInfo]
-> lookupP = lookupTopEnv
-
-> qualLookupP :: QualIdent -> PEnv -> [PrecInfo]
-> qualLookupP = qualLookupTopEnv
-
-> initPEnv :: PEnv
-> initPEnv =
->   predefTopEnv qConsId (PrecInfo qConsId (OpPrec InfixR 5)) emptyTopEnv
-
-\end{verbatim}

src/Env/TypeConstructor.hs

+{- |
+    Module      :  $Header$
+    Description :  Environment of type constructors
+    Copyright   :  (c) 2002-2004, Wolfgang Lux
+                       2011, Björn Peemöller   (bjp@informatik.uni-kiel.de)
+    License     :  OtherLicense
+
+    Maintainer  :  bjp@informatik.uni-kiel.de
+    Stability   :  experimental
+    Portability :  portable
+
+    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.
+-}
+
+module Env.TypeConstructor
+  ( TCEnv, TypeInfo (..), tcArity, bindTypeInfo, lookupTC, qualLookupTC
+  , lookupTupleTC, tupleTCs, tupleData, initTCEnv
+  ) where
+
+import Control.Monad (mplus)
+
+import Curry.Base.Ident
+
+import Base.TopEnv
+import Base.Types
+import Base.Utils ((++!))
+
+data TypeInfo
+  = DataType     QualIdent Int [Maybe DataConstr]
+  | RenamingType QualIdent Int DataConstr
+  | AliasType    QualIdent Int Type
+    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
+
+-- 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.
+
+type TCEnv = TopEnv TypeInfo
+
+bindTypeInfo :: (QualIdent -> Int -> a -> TypeInfo) -> ModuleIdent
+             -> Ident -> [Ident] -> a -> TCEnv -> TCEnv
+bindTypeInfo f m tc tvs x = bindTopEnv fun tc ty . qualBindTopEnv fun qtc ty
+  where qtc = qualifyWith m tc
+        ty  = f qtc (length tvs) x
+        fun = "Base.bindTypeInfo"
+
+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 (DataConstr c _ tys) =
+          DataType (qualifyWith preludeMIdent c) (length tys)
+                   [Just (DataConstr c 0 tys)]
+
+tupleData :: [DataConstr]
+tupleData = [DataConstr (tupleId n) 0 (take n tvs) | n <- [2 ..]]
+  where tvs = map typeVar [0 ..]
+
+initTCEnv :: TCEnv
+initTCEnv = foldr (uncurry predefTC) emptyTopEnv predefTypes
+  where predefTC (TypeConstructor tc tys) =
+          predefTopEnv (qualify (unqualify tc)) .
+            DataType tc (length tys) . map Just
+        predefTC _ = error "Base.initTCEnv.predefTC: no type constructor"

src/Env/TypeConstructors.lhs

-\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}
-
-> module Env.TypeConstructors
->   ( TCEnv, TypeInfo (..), tcArity, bindTypeInfo, lookupTC, qualLookupTC
->   , lookupTupleTC, tupleTCs, tupleData, initTCEnv
->   ) where
-
-> import Control.Monad (mplus)
-
-> import Curry.Base.Ident
-
-> import Base.TopEnv
-> import Base.Types