TopEnv.lhs 5.8 KB
Newer Older
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
% $Id: TopEnv.lhs,v 1.20 2003/10/04 17:04:32 wlux Exp $
%
% Copyright (c) 1999-2003, Wolfgang Lux
% See LICENSE for the full license.
%
% Modified by Martin Engelke (men@informatik.uni-kiel.de)
%
\nwfilename{TopEnv.lhs}
\subsection{Top-Level Environments}\label{sec:toplevel-env}
The module \texttt{TopEnv} implements environments for qualified and
possibly ambiguous identifiers. An identifier is ambiguous if two
different entities are imported under the same name or if a local
definition uses the same name as an imported entity. Following an idea
presented in \cite{DiatchkiJonesHallgren02:ModuleSystem}, an
identifier is associated with a list of entities in order to handle
ambiguous names properly.

In general, two entities are considered equal if the names of their
original definitions match.  However, in the case of algebraic data
types it is possible to hide some or all of their data constructors on
import and export, respectively. In this case we have to merge both
imports such that all data constructors which are visible through any
import path are visible in the current module. The class
\texttt{Entity} is used to handle this merge.

The code in this module ensures that the list of entities returned by
the functions \texttt{lookupTopEnv} and \texttt{qualLookupTopEnv}
contains exactly one element for each imported entity regardless of
how many times and from which module(s) it was imported. Thus, the
result of these function is a list with exactly one element if and
only if the identifier is unambiguous. The module names associated
with an imported entity identify the modules from which the entity was
imported.
\begin{verbatim}

> module Env.TopEnv
>   ( TopEnv (..), Entity (..), emptyTopEnv, predefTopEnv, qualImportTopEnv
>   , importTopEnv, bindTopEnv, qualBindTopEnv, rebindTopEnv, qualRebindTopEnv
>   , unbindTopEnv, lookupTopEnv, qualLookupTopEnv
>   , allImports, moduleImports,localBindings
>   ) where

> import Control.Arrow (second)
> import qualified Data.Map as Map
> import Data.Maybe

> import Curry.Base.Ident
Björn Peemöller 's avatar
Björn Peemöller committed
48
> import Base.Messages (internalError)
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73

> data Source = Local | Import [ModuleIdent] deriving (Eq, Show)

> class Entity a where
>  origName :: a -> QualIdent
>  merge    :: a -> a -> Maybe a
>  merge x y
>    | origName x == origName y = Just x
>    | otherwise = Nothing

> newtype TopEnv a = TopEnv { topEnvMap :: Map.Map QualIdent [(Source, a)]
>                           } deriving Show

> instance Functor TopEnv where
>   fmap f (TopEnv env) = TopEnv (fmap (map (second f)) env)

> entities :: QualIdent -> Map.Map QualIdent [(Source,a)] -> [(Source, a)]
> entities x env = fromMaybe [] (Map.lookup x env)

> emptyTopEnv :: TopEnv a
> emptyTopEnv = TopEnv Map.empty

> predefTopEnv :: Entity a => QualIdent -> a -> TopEnv a -> TopEnv a
> predefTopEnv x y (TopEnv env) =
>   case Map.lookup x env of
74
>     Just _ -> internalError "TopEnv.predefTopEnv"
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
>     Nothing -> TopEnv (Map.insert x [(Import [],y)] env)

> importTopEnv :: Entity a => ModuleIdent -> Ident -> a -> TopEnv a -> TopEnv a
> importTopEnv m x y (TopEnv env) =
>   TopEnv (Map.insert x' (mergeImport m y (entities x' env)) env)
>   where x' = qualify x

> qualImportTopEnv :: Entity a => ModuleIdent -> Ident -> a -> TopEnv a
>                  -> TopEnv a
> qualImportTopEnv m x y (TopEnv env) =
>   TopEnv (Map.insert x' (mergeImport m y (entities x' env)) env)
>   where x' = qualifyWith m x

> mergeImport :: Entity a => ModuleIdent -> a -> [(Source,a)] -> [(Source,a)]
> mergeImport m x [] = [(Import [m],x)]
> mergeImport m x ((Local,x') : xs) = (Local,x') : mergeImport m x xs
> mergeImport m x ((Import ms,x') : xs) =
>   case merge x x' of
>     Just x'' -> (Import (m:ms),x'') : xs
>     Nothing -> (Import ms,x') : mergeImport m x xs

> bindTopEnv :: String -> Ident -> a -> TopEnv a -> TopEnv a
> bindTopEnv fun x y env = qualBindTopEnv fun (qualify x) y env

> qualBindTopEnv :: String -> QualIdent -> a -> TopEnv a -> TopEnv a
> qualBindTopEnv fun x y (TopEnv env) =
>   TopEnv (Map.insert x (bindLocal y (entities x env)) env)
>   where bindLocal y' ys
>           | null [y'' | (Local,y'') <- ys] = (Local,y') : ys
104
105
>           | otherwise = internalError $ "\"qualBindTopEnv " ++ show x
>                       ++ "\" failed in function \"" ++ fun ++ "\""
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
106
107
108
109
110
111
112

> rebindTopEnv :: Ident -> a -> TopEnv a -> TopEnv a
> rebindTopEnv = qualRebindTopEnv . qualify

> qualRebindTopEnv :: QualIdent -> a -> TopEnv a -> TopEnv a
> qualRebindTopEnv x y (TopEnv env) =
>   TopEnv (Map.insert x (rebindLocal (entities x env)) env)
113
>   where rebindLocal [] = internalError "TopEnv.qualRebindTopEnv"
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
114
115
116
117
118
119
120
>         rebindLocal ((Local,_) : ys) = (Local,y) : ys
>         rebindLocal ((Import ms,y') : ys) = (Import ms,y') : rebindLocal ys

> unbindTopEnv :: Ident -> TopEnv a -> TopEnv a
> unbindTopEnv x (TopEnv env) =
>   TopEnv (Map.insert x' (unbindLocal (entities x' env)) env)
>   where x' = qualify x
121
>         unbindLocal [] = internalError "TopEnv.unbindTopEnv"
Bjoern Peemoeller's avatar
Bjoern Peemoeller committed
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
>         unbindLocal ((Local,_) : ys) = ys
>         unbindLocal ((Import ms,y) : ys) = (Import ms,y) : unbindLocal ys

> lookupTopEnv :: Ident -> TopEnv a -> [a]
> lookupTopEnv = qualLookupTopEnv . qualify

> qualLookupTopEnv :: QualIdent -> TopEnv a -> [a]
> qualLookupTopEnv x (TopEnv env) = map snd (entities x env)

> allImports :: TopEnv a -> [(QualIdent,a)]
> allImports (TopEnv env) =
>   [(x,y) | (x,ys) <- Map.toList env, (Import _,y) <- ys]

> unqualBindings :: TopEnv a -> [(Ident,(Source,a))]
> unqualBindings (TopEnv env) =
>   [(x',y) | (x,ys) <- takeWhile (not . isQualified . fst) (Map.toList env),
>             let x' = unqualify x, y <- ys]

> moduleImports :: ModuleIdent -> TopEnv a -> [(Ident,a)]
> moduleImports m env =
>   [(x,y) | (x,(Import ms,y)) <- unqualBindings env, m `elem` ms]

> localBindings :: TopEnv a -> [(Ident,a)]
> localBindings env = [(x,y) | (x,(Local,y)) <- unqualBindings env]

\end{verbatim}