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

Refactoring of envs

parent ea8e1e39
......@@ -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
......
......@@ -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
......
{- |
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]
......@@ -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}
......@@ -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
......
......@@ -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}
......
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