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
e19d83c9
Commit
e19d83c9
authored
Sep 05, 2011
by
Björn Peemöller
Browse files
Refactoring of envs
parent
ea8e1e39
Changes
6
Hide whitespace changes
Inline
Side-by-side
src/Env/Arity.hs
View file @
e19d83c9
...
...
@@ -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
View file @
e19d83c9
...
...
@@ -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
View file @
e19d83c9
{- |
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
View file @
e19d83c9
...
...
@@ -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"
q
op
info
>
|
otherwise
=
bindTopEnv
"Base.bindP"
op
info
>
where
q
op
=
qualifyWith
m
op
>
info
=
PrecInfo
q
op
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
View file @
e19d83c9
...
...
@@ -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
View file @
e19d83c9
...
...
@@ -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}
...
...
Write
Preview
Markdown
is supported
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