Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
curry
curry-frontend
Commits
92227c27
Commit
92227c27
authored
Sep 05, 2011
by
Björn Peemöller
Browse files
Basic envs moved to Base
parent
6081fb44
Changes
5
Hide whitespace changes
Inline
Side-by-side
curry-frontend.cabal
View file @
92227c27
...
...
@@ -57,8 +57,12 @@ Executable cymake
, Base.CurryTypes
, Base.Expr
, Base.Messages
, Base.NestEnv
, Base.OldScopeEnv
, Base.SCC
, Base.ScopeEnv
, Base.Subst
, Base.TopEnv
, Base.Types
, Base.TypeSubst
, Base.Typing
...
...
@@ -73,11 +77,7 @@ Executable cymake
, Env.Interface
, Env.Label
, Env.ModuleAlias
, Env.NestEnv
, Env.OldScopeEnv
, Env.OpPrec
, Env.ScopeEnv
, Env.TopEnv
, Env.TypeConstructors
, Env.Value
, Generators.GenAbstractCurry
...
...
src/
Env
/NestEnv.lhs
→
src/
Base
/NestEnv.lhs
View file @
92227c27
% $Id: NestEnv.lhs,v 1.11 2003/10/04 17:04:23 wlux Exp $
%
% Copyright (c) 1999-2003, Wolfgang Lux
...
...
@@ -11,12 +10,11 @@ The \texttt{NestEnv} environment type extends top-level environments
scopes allow only for a single, unambiguous definition.
As a matter of convenience, the module \texttt{TopEnv} is exported by
the module \texttt{NestEnv}. Thus, only the latter needs to be
imported.
the module \texttt{NestEnv}. Thus, only the latter needs to be imported.
\begin{verbatim}
>
module
Env
.NestEnv
>
(
module
Env
.TopEnv
>
module
Base
.NestEnv
>
(
module
Base
.TopEnv
>
,
NestEnv
,
bindNestEnv
,
qualBindNestEnv
,
lookupNestEnv
,
qualLookupNestEnv
>
,
toplevelEnv
,
globalEnv
,
nestEnv
>
)
where
...
...
@@ -25,56 +23,53 @@ imported.
>
import
Curry.Base.Ident
>
import
Base.Messages
(
internalError
)
>
import
Base.TopEnv
>
import
Env.TopEnv
>
data
NestEnv
a
=
GlobalEnv
(
TopEnv
a
)
>
|
LocalEnv
(
NestEnv
a
)
(
Map
.
Map
Ident
a
)
>
-- deriving Show
>
data
NestEnv
a
>
=
GlobalEnv
(
TopEnv
a
)
>
|
LocalEnv
(
NestEnv
a
)
(
Map
.
Map
Ident
a
)
>
deriving
Show
>
instance
Functor
NestEnv
where
>
fmap
f
(
GlobalEnv
env
)
=
GlobalEnv
(
fmap
f
env
)
>
fmap
f
(
LocalEnv
genv
env
)
=
LocalEnv
(
fmap
f
genv
)
(
fmap
f
env
)
>
fmap
f
(
GlobalEnv
env
)
=
GlobalEnv
(
fmap
f
env
)
>
fmap
f
(
LocalEnv
genv
env
)
=
LocalEnv
(
fmap
f
genv
)
(
fmap
f
env
)
>
globalEnv
::
TopEnv
a
->
NestEnv
a
>
globalEnv
=
GlobalEnv
>
nestEnv
::
NestEnv
a
->
NestEnv
a
>
nestEnv
env
=
LocalEnv
env
Map
.
empty
>
toplevelEnv
::
NestEnv
a
->
TopEnv
a
>
toplevelEnv
(
GlobalEnv
env
)
=
env
>
toplevelEnv
(
LocalEnv
genv
_
)
=
toplevelEnv
genv
>
bindNestEnv
::
Ident
->
a
->
NestEnv
a
->
NestEnv
a
>
bindNestEnv
x
y
(
GlobalEnv
env
)
>
=
GlobalEnv
(
bindTopEnv
"NestEnv.bindNestEnv"
x
y
env
)
>
bindNestEnv
x
y
(
LocalEnv
genv
env
)
=
>
case
Map
.
lookup
x
env
of
>
Just
_
->
internalError
"NestEnv.bindNestEnv"
>
Nothing
->
LocalEnv
genv
(
Map
.
insert
x
y
env
)
>
=
GlobalEnv
$
bindTopEnv
"NestEnv.bindNestEnv"
x
y
env
>
bindNestEnv
x
y
(
LocalEnv
genv
env
)
=
case
Map
.
lookup
x
env
of
>
Just
_
->
internalError
"NestEnv.bindNestEnv"
>
Nothing
->
LocalEnv
genv
$
Map
.
insert
x
y
env
>
qualBindNestEnv
::
QualIdent
->
a
->
NestEnv
a
->
NestEnv
a
>
qualBindNestEnv
x
y
(
GlobalEnv
env
)
>
=
GlobalEnv
(
qualBindTopEnv
"NestEnv.qualBindNestEnv"
x
y
env
)
>
=
GlobalEnv
$
qualBindTopEnv
"NestEnv.qualBindNestEnv"
x
y
env
>
qualBindNestEnv
x
y
(
LocalEnv
genv
env
)
>
|
isQualified
x
=
internalError
"NestEnv.qualBindNestEnv"
>
|
otherwise
=
>
case
Map
.
lookup
x'
env
of
>
Just
_
->
internalError
"NestEnv.qualBindNestEnv"
>
Nothing
->
LocalEnv
genv
(
Map
.
insert
x'
y
env
)
>
where
x'
=
unqualify
x
>
|
otherwise
=
case
Map
.
lookup
x'
env
of
>
Just
_
->
internalError
"NestEnv.qualBindNestEnv"
>
Nothing
->
LocalEnv
genv
$
Map
.
insert
x'
y
env
>
where
x'
=
unqualify
x
>
lookupNestEnv
::
Ident
->
NestEnv
a
->
[
a
]
>
lookupNestEnv
x
(
GlobalEnv
env
)
=
lookupTopEnv
x
env
>
lookupNestEnv
x
(
LocalEnv
genv
env
)
=
>
case
Map
.
lookup
x
env
of
>
Just
y
->
[
y
]
>
Nothing
->
lookupNestEnv
x
genv
>
lookupNestEnv
x
(
GlobalEnv
env
)
=
lookupTopEnv
x
env
>
lookupNestEnv
x
(
LocalEnv
genv
env
)
=
case
Map
.
lookup
x
env
of
>
Just
y
->
[
y
]
>
Nothing
->
lookupNestEnv
x
genv
>
qualLookupNestEnv
::
QualIdent
->
NestEnv
a
->
[
a
]
>
qualLookupNestEnv
x
env
>
|
isQualified
x
=
qualLookupTopEnv
x
(
toplevelEnv
env
)
>
|
otherwise
=
lookupNestEnv
(
unqualify
x
)
env
>
toplevelEnv
::
NestEnv
a
->
TopEnv
a
>
toplevelEnv
(
GlobalEnv
env
)
=
env
>
toplevelEnv
(
LocalEnv
genv
_
)
=
toplevelEnv
genv
>
globalEnv
::
TopEnv
a
->
NestEnv
a
>
globalEnv
=
GlobalEnv
>
nestEnv
::
NestEnv
a
->
NestEnv
a
>
nestEnv
env
=
LocalEnv
env
Map
.
empty
>
|
isQualified
x
=
qualLookupTopEnv
x
$
toplevelEnv
env
>
|
otherwise
=
lookupNestEnv
(
unqualify
x
)
env
\end{verbatim}
src/
Env
/OldScopeEnv.hs
→
src/
Base
/OldScopeEnv.hs
View file @
92227c27
module
Env.OldScopeEnv
(
ScopeEnv
,
newScopeEnv
,
insertIdent
,
getIdentLevel
,
isVisible
,
isDeclared
,
beginScope
,
endScope
,
getLevel
,
genIdent
,
genIdentList
module
Base.OldScopeEnv
(
ScopeEnv
,
newScopeEnv
,
beginScope
,
insertIdent
,
genIdentList
)
where
import
Data.Maybe
import
qualified
Data.Map
as
Map
import
Curry.Base.Ident
-- The IdEnv is an environment which stores the level in which an identifier
-- was defined, starting with 0 for the top-level.
type
IdEnv
=
Map
.
Map
IdRep
Integer
data
IdRep
=
Name
String
|
Index
Integer
deriving
(
Eq
,
Ord
)
insertId
::
Integer
->
Ident
->
IdEnv
->
IdEnv
insertId
level
ident
=
Map
.
insert
(
Name
(
name
ident
))
level
.
Map
.
insert
(
Index
(
uniqueId
ident
))
level
nameExists
::
String
->
IdEnv
->
Bool
nameExists
idName
=
Map
.
member
(
Name
idName
)
indexExists
::
Integer
->
IdEnv
->
Bool
indexExists
index
=
Map
.
member
(
Index
index
)
genId
::
String
->
IdEnv
->
Maybe
Ident
genId
n
env
|
nameExists
n
env
=
Nothing
|
otherwise
=
Just
(
p_genId
(
mkIdent
n
)
0
)
where
p_genId
ident
index
|
indexExists
index
env
=
p_genId
ident
(
index
+
1
)
|
otherwise
=
renameIdent
ident
index
{- Type for representing an environment containing identifiers in several
scope levels -}
type
ScopeLevel
=
Integer
type
ScopeEnv
=
(
IdEnv
,
[
IdEnv
],
ScopeLevel
)
type
ScopeEnv
=
(
IdEnv
,
[
IdEnv
],
ScopeLevel
)
-- (top-level IdEnv, stack of lower level IdEnv, current level)
-- Invariant: The current level is the number of stack elements
-- Generates a new instance of a scope table
newScopeEnv
::
ScopeEnv
newScopeEnv
=
(
Map
.
empty
,
[]
,
0
)
-- Insert
s
an identifier into the current level of the scope environment
-- Insert an identifier into the current level of the scope environment
insertIdent
::
Ident
->
ScopeEnv
->
ScopeEnv
insertIdent
ident
(
topleveltab
,
leveltabs
,
level
)
=
case
leveltabs
of
(
lt
:
lts
)
->
(
topleveltab
,
(
insertId
level
ident
lt
)
:
lts
,
level
)
[]
->
((
insertId
level
ident
topleveltab
),
[]
,
0
)
-- Returns the declaration level of an identifier if it exists
getIdentLevel
::
Ident
->
ScopeEnv
->
Maybe
Integer
getIdentLevel
ident
(
topleveltab
,
leveltabs
,
_
)
=
case
leveltabs
of
(
lt
:
_
)
->
maybe
(
getIdLevel
ident
topleveltab
)
Just
(
getIdLevel
ident
lt
)
[]
->
getIdLevel
ident
topleveltab
-- Checks whether the specified identifier is visible in the current scope
-- (i.e. checks whether the identifier occurs in the scope environment)
isVisible
::
Ident
->
ScopeEnv
->
Bool
isVisible
ident
(
topleveltab
,
leveltabs
,
_
)
=
case
leveltabs
of
(
lt
:
_
)
->
idExists
ident
lt
||
idExists
ident
topleveltab
[]
->
idExists
ident
topleveltab
-- Checks whether the specified identifier is declared in the
-- current scope (i.e. checks whether the identifier occurs in the
-- current level of the scope environment)
isDeclared
::
Ident
->
ScopeEnv
->
Bool
isDeclared
ident
(
topleveltab
,
leveltabs
,
level
)
=
case
leveltabs
of
(
lt
:
_
)
->
maybe
False
((
==
)
level
)
(
getIdLevel
ident
lt
)
[]
->
maybe
False
((
==
)
0
)
(
getIdLevel
ident
topleveltab
)
-- Increases the level of the scope.
beginScope
::
ScopeEnv
->
ScopeEnv
beginScope
(
topleveltab
,
leveltabs
,
level
)
=
case
leveltabs
of
(
lt
:
lts
)
->
(
topleveltab
,
(
lt
:
lt
:
lts
),
level
+
1
)
[]
->
(
topleveltab
,
[
Map
.
empty
],
1
)
-- Decreases the level of the scope. Identifier from higher levels
-- will be lost.
endScope
::
ScopeEnv
->
ScopeEnv
endScope
(
topleveltab
,
leveltabs
,
level
)
=
case
leveltabs
of
(
_
:
lts
)
->
(
topleveltab
,
lts
,
level
-
1
)
[]
->
(
topleveltab
,
[]
,
0
)
-- Returns the level of the current scope. Top level is 0
getLevel
::
ScopeEnv
->
ScopeLevel
getLevel
(
_
,
_
,
level
)
=
level
insertIdent
ident
(
topleveltab
,
leveltabs
,
level
)
=
case
leveltabs
of
[]
->
((
insertId
level
ident
topleveltab
),
[]
,
0
)
(
lt
:
lts
)
->
(
topleveltab
,
(
insertId
level
ident
lt
)
:
lts
,
level
)
-- Generates a new identifier for the specified name. The new identifier is
-- unique within the current scope. If no identifier can be generated for
-- 'name' then 'Nothing' will be returned
genIdent
::
String
->
ScopeEnv
->
Maybe
Ident
genIdent
idName
(
topleveltab
,
leveltabs
,
_
)
=
case
leveltabs
of
(
lt
:
_
)
->
genId
idName
lt
[]
->
genId
idName
topleveltab
-- Increase the level of the scope.
beginScope
::
ScopeEnv
->
ScopeEnv
beginScope
(
topleveltab
,
leveltabs
,
level
)
=
case
leveltabs
of
[]
->
(
topleveltab
,
[
Map
.
empty
],
1
)
(
lt
:
lts
)
->
(
topleveltab
,
(
lt
:
lt
:
lts
),
level
+
1
)
-- Generates a list of new identifiers where each identifier has
-- the prefix 'name' followed by an index (i.e. "var3" if 'name' was "var").
...
...
@@ -92,43 +69,48 @@ genIdentList size idName scopeenv = p_genIdentList size idName scopeenv 0
(
i
+
1
)))
(
genIdent
(
n
++
(
show
i
))
env
)
{- ---------------------------------------------------------------------------
Private declarations...
--------------------------------------------------------------------------- -}
type
IdEnv
=
Map
.
Map
IdRep
Integer
data
IdRep
=
Name
String
|
Index
Integer
deriving
(
Eq
,
Ord
)
--
insertId
::
Integer
->
Ident
->
IdEnv
->
IdEnv
insertId
level
ident
env
=
Map
.
insert
(
Name
(
name
ident
))
level
(
Map
.
insert
(
Index
(
uniqueId
ident
))
level
env
)
--
idExists
::
Ident
->
IdEnv
->
Bool
idExists
ident
env
=
indexExists
(
uniqueId
ident
)
env
--
getIdLevel
::
Ident
->
IdEnv
->
Maybe
Integer
getIdLevel
ident
env
=
Map
.
lookup
(
Index
(
uniqueId
ident
))
env
--
genId
::
String
->
IdEnv
->
Maybe
Ident
genId
n
env
|
nameExists
n
env
=
Nothing
|
otherwise
=
Just
(
p_genId
(
mkIdent
n
)
0
)
where
p_genId
ident
index
|
indexExists
index
env
=
p_genId
ident
(
index
+
1
)
|
otherwise
=
renameIdent
ident
index
--
nameExists
::
String
->
IdEnv
->
Bool
nameExists
idName
env
=
isJust
(
Map
.
lookup
(
Name
idName
)
env
)
-- Generates a new identifier for the specified name. The new identifier is
-- unique within the current scope. If no identifier can be generated for
-- 'name' then 'Nothing' will be returned
genIdent
::
String
->
ScopeEnv
->
Maybe
Ident
genIdent
idName
(
topleveltab
,
leveltabs
,
_
)
=
case
leveltabs
of
[]
->
genId
idName
topleveltab
(
lt
:
_
)
->
genId
idName
lt
-- -- Return the declaration level of an identifier if it exists
-- getIdentLevel :: Ident -> ScopeEnv -> Maybe Integer
-- getIdentLevel ident (topleveltab, leveltabs, _) = case leveltabs of
-- [] -> getIdLevel ident topleveltab
-- (lt:_) -> maybe (getIdLevel ident topleveltab) Just (getIdLevel ident lt)
-- -- Checkswhether the specified identifier is visible in the current scope
-- -- (i.e. check whether the identifier occurs in the scope environment)
-- isVisible :: Ident -> ScopeEnv -> Bool
-- isVisible ident (topleveltab, leveltabs, _) = case leveltabs of
-- [] -> idExists ident topleveltab
-- (lt:_) -> idExists ident lt || idExists ident topleveltab
--
indexExists
::
Integer
->
IdEnv
->
Bool
indexExists
index
env
=
isJust
(
Map
.
lookup
(
Index
index
)
env
)
-- -- Check whether the specified identifier is declared in the
-- -- current scope (i.e. checks whether the identifier occurs in the
-- -- current level of the scope environment)
-- isDeclared :: Ident -> ScopeEnv -> Bool
-- isDeclared ident (topleveltab, leveltabs, level) = case leveltabs of
-- [] -> maybe False ((==) 0) (getIdLevel ident topleveltab)
-- (lt:_) -> maybe False ((==) level) (getIdLevel ident lt)
-- -- Decrease the level of the scope. Identifier from higher levels
-- -- will be lost.
-- endScope :: ScopeEnv -> ScopeEnv
-- endScope (topleveltab, leveltabs, level) = case leveltabs of
-- [] -> (topleveltab, [], 0)
-- (_:lts) -> (topleveltab, lts, level - 1)
-- -- Return the level of the current scope. Top level is 0
-- getLevel :: ScopeEnv -> ScopeLevel
-- getLevel (_, _, level) = level
-- idExists :: Ident -> IdEnv -> Bool
-- idExists ident = indexExists (uniqueId ident)
-- getIdLevel :: Ident -> IdEnv -> Maybe Integer
-- getIdLevel ident = Map.lookup (Index (uniqueId ident))
src/
Env
/ScopeEnv.hs
→
src/
Base
/ScopeEnv.hs
View file @
92227c27
...
...
@@ -7,7 +7,7 @@
November 2005,
Martin Engelke (men@informatik.uni-kiel.de)
-}
module
Env
.ScopeEnv
module
Base
.ScopeEnv
(
ScopeEnv
,
new
,
insert
,
update
,
modify
,
lookup
,
sureLookup
,
level
,
exists
,
beginScope
,
endScope
,
endScopeUp
,
toList
,
toLevelList
,
currentLevel
...
...
src/
Env
/TopEnv.lhs
→
src/
Base
/TopEnv.lhs
View file @
92227c27
File moved
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment