TopEnv.lhs 5.77 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
48
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
74
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
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
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
% $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
> import Messages (internalError)

> 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
>     Just _ -> internalError "predefTopEnv"
>     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
>           | otherwise = internalError ("\"qualBindTopEnv " ++ show x
>                       ++ "\" failed in function \"" ++ fun ++ "\"")

> 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)
>   where rebindLocal [] = internalError "qualRebindTopEnv"
>         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
>         unbindLocal [] = internalError "unbindTopEnv"
>         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}