Refactoring of envs

src/Env/Arity.hs

@@ -15,11 +15,10 @@ module Env.Arity
 import Curry.Base.Ident
 import Curry.Syntax
 
+import Base.TopEnv
 import Base.Types (DataConstr (..), predefTypes)
 import Base.Utils ((++!))
 
-import Env.TopEnv
-
 type ArityEnv = TopEnv ArityInfo
 
 data ArityInfo = ArityInfo QualIdent Int deriving Show

src/Env/Eval.lhs

@@ -24,17 +24,17 @@ The function \texttt{evalEnv} collects all evaluation annotations of
 the module by traversing the syntax tree.
 \begin{verbatim}
 
-> evalEnv :: Module -> EvalEnv
-> evalEnv (Module _ _ _ ds) = foldr collectAnnotsDecl Map.empty ds
-
 > 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
+> collectAnnotsDecl _                      env = env
 
 > collectAnnotsEqn :: Equation -> EvalEnv -> EvalEnv
 > collectAnnotsEqn (Equation _ _ rhs) = collectAnnotsRhs rhs
@@ -89,8 +89,8 @@ the module by traversing the syntax tree.
 >   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 (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

src/Env/Label.hs

+{- |
+    Module      :  $Header$
+    Description :  Environment for record labels
+    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
+
+    The label environment is used to store information of labels.
+    Unlike usual 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.
+-}
 module Env.Label where
 
 import qualified Data.Map as Map (Map, empty, insertWith)
@@ -6,20 +24,12 @@ import Curry.Base.Ident (Ident, QualIdent)
 
 import Base.Types
 
--- The label environment is used to store information of labels.
--- Unlike usual 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 = Map.Map Ident [LabelInfo]
 
-bindLabelType :: Ident -> QualIdent -> Type -> LabelEnv -> LabelEnv
-bindLabelType l r ty = Map.insertWith (++) l [LabelType l r ty]
-
 initLabelEnv :: LabelEnv
 initLabelEnv = Map.empty
+
+bindLabelType :: Ident -> QualIdent -> Type -> LabelEnv -> LabelEnv
+bindLabelType l r ty = Map.insertWith (++) l [LabelType l r ty]

src/Env/OpPrec.lhs

@@ -19,20 +19,20 @@ introduction of unlimited integer constants in the parser / lexer.
 >   , initPEnv ) where
 
 > import Curry.Base.Ident
-> import qualified Curry.Syntax as CS
+> import Curry.Syntax (Infix (..))
 
-> import Env.TopEnv
+> import Base.TopEnv
 
-> data OpPrec = OpPrec CS.Infix Integer deriving Eq
+> data OpPrec = OpPrec Infix Integer deriving Eq
 
 > instance Show OpPrec where
 >   showsPrec _ (OpPrec fix p) = showString (assoc fix) . shows p
->     where assoc CS.InfixL = "left "
->           assoc CS.InfixR = "right "
->           assoc CS.Infix  = "non-assoc "
+>     where assoc InfixL = "left "
+>           assoc InfixR = "right "
+>           assoc Infix  = "non-assoc "
 
 > defaultP :: OpPrec
-> defaultP = OpPrec CS.InfixL 9
+> defaultP = OpPrec InfixL 9
 
 \end{verbatim}
 The lookup functions for the environment which maintains the operator
@@ -49,11 +49,11 @@ because they do not need to handle tuple constructors.
 
 > bindP :: ModuleIdent -> Ident -> OpPrec -> PEnv -> PEnv
 > bindP m op p
->   | uniqueId op == 0
->     = bindTopEnv "Base.bindP" op info . qualBindTopEnv "Base.bindP" op' info
->   | otherwise = bindTopEnv "Base.bindP" op info
->   where op' = qualifyWith m op
->         info = PrecInfo 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
@@ -63,6 +63,6 @@ because they do not need to handle tuple constructors.
 
 > initPEnv :: PEnv
 > initPEnv =
->   predefTopEnv qConsId (PrecInfo qConsId (OpPrec CS.InfixR 5)) emptyTopEnv
+>   predefTopEnv qConsId (PrecInfo qConsId (OpPrec InfixR 5)) emptyTopEnv
 
 \end{verbatim}

src/Env/TypeConstructors.lhs

@@ -36,11 +36,10 @@ changes which are private to the module.
 
 > import Curry.Base.Ident
 
+> import Base.TopEnv
 > import Base.Types
 > import Base.Utils ((++!))
 
-> import Env.TopEnv
-
 > data TypeInfo = DataType QualIdent Int [Maybe DataConstr]
 >               | RenamingType QualIdent Int DataConstr
 >               | AliasType QualIdent Int Type

src/Env/Value.lhs

@@ -21,11 +21,11 @@ are considered equal if their original names match.
 > import Curry.Syntax
 
 > import Base.CurryTypes (fromQualType)
+> import Base.TopEnv
 > import Base.Types
 > import Base.Utils ((++!))
 
 > import Env.TypeConstructors (TypeInfo (..), tupleTCs)
-> import Env.TopEnv
 
 > data ValueInfo
 >   = DataConstructor QualIdent ExistTypeScheme
@@ -35,17 +35,17 @@ are considered equal if their original names match.
 >     deriving Show
 
 > instance Entity ValueInfo where
->   origName (DataConstructor orgName _) = orgName
+>   origName (DataConstructor    orgName _) = orgName
 >   origName (NewtypeConstructor orgName _) = orgName
->   origName (Value orgName _) = orgName
->   origName (Label orgName _ _) = orgName
+>   origName (Value              orgName _) = orgName
+>   origName (Label            orgName _ _) = orgName
 >
 >   merge (Label l r ty) (Label l' r' _)
 >     | l == l' && r == r' = Just (Label l r ty)
->     | otherwise = Nothing
+>     | otherwise          = Nothing
 >   merge x y
 >     | origName x == origName y = Just x
->     | otherwise = Nothing
+>     | otherwise                = Nothing
 
 
 \end{verbatim}