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
2aeb3b59
Commit
2aeb3b59
authored
Oct 07, 2011
by
Björn Peemöller
Browse files
Import of record fields now works, LabelEnv became obsolete
parent
c064369e
Changes
8
Hide whitespace changes
Inline
Side-by-side
TODO
View file @
2aeb3b59
...
...
@@ -2,14 +2,15 @@ Completed
=========
- Anonymous free variables implemented
- hierarchically structured modules
Still to do
===========
- !!! Check correctness of created FlatCurry files by comparison with the old frontend !!!
- Records: There is no way to explicitly import a record with its fields:
import CompilerOpts -- okay, works
import CompilerOpts (Options) -- okay, but no field labels imported
import CompilerOpts (Options (..)) -- fails: Options is not a data type
Still to do
===========
- !!! Check correctness of created FlatCurry files by comparison
!!! with the old frontend
- Module pragmas
- type classes
- option to disable nondeterminism by overlapping
...
...
curry-frontend.cabal
View file @
2aeb3b59
...
...
@@ -65,7 +65,6 @@ Executable cymake
, CurryDeps
, Env.Eval
, Env.Interface
, Env.Label
, Env.ModuleAlias
, Env.OpPrec
, Env.TypeConstructors
...
...
src/CompilerEnv.hs
View file @
2aeb3b59
...
...
@@ -11,16 +11,12 @@
This module defines an environment for a module containing the information
needed throughout the compilation of the module.
-}
-- TODO: rename to Base.ModuleEnv ?
module
CompilerEnv
where
import
Curry.Base.Ident
(
ModuleIdent
)
import
Env.Eval
import
Env.Interface
import
Env.Label
import
Env.ModuleAlias
import
Env.OpPrec
import
Env.TypeConstructors
...
...
@@ -34,7 +30,6 @@ data CompilerEnv = CompilerEnv
,
aliasEnv
::
AliasEnv
-- ^ aliases for imported modules
,
evalAnnotEnv
::
EvalEnv
-- ^ evaluation annotations
,
interfaceEnv
::
InterfaceEnv
-- ^ declarations of imported interfaces
,
labelEnv
::
LabelEnv
-- ^ record labels
,
opPrecEnv
::
PEnv
-- ^ operator precedences
,
tyConsEnv
::
TCEnv
-- ^ type constructors
,
valueEnv
::
ValueEnv
-- ^ functions and data constructors
...
...
@@ -46,7 +41,6 @@ initCompilerEnv mid = CompilerEnv
,
aliasEnv
=
initAliasEnv
,
evalAnnotEnv
=
initEEnv
,
interfaceEnv
=
initInterfaceEnv
,
labelEnv
=
initLabelEnv
,
opPrecEnv
=
initPEnv
,
tyConsEnv
=
initTCEnv
,
valueEnv
=
initDCEnv
...
...
src/Env/Label.hs
deleted
100644 → 0
View file @
c064369e
{- |
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
)
import
Curry.Base.Ident
(
Ident
,
QualIdent
)
import
Base.Types
data
LabelInfo
=
LabelType
Ident
QualIdent
Type
deriving
Show
type
LabelEnv
=
Map
.
Map
Ident
[
LabelInfo
]
initLabelEnv
::
LabelEnv
initLabelEnv
=
Map
.
empty
bindLabelType
::
Ident
->
QualIdent
->
Type
->
LabelEnv
->
LabelEnv
bindLabelType
l
r
ty
=
Map
.
insertWith
(
++
)
l
[
LabelType
l
r
ty
]
src/Imports.hs
View file @
2aeb3b59
...
...
@@ -35,19 +35,18 @@ import Env.Value
import
CompilerEnv
import
CompilerOpts
import
Records
(
importLabels
,
recordExpansion1
,
recordExpansion2
)
import
Records
(
expandTCValueEnv
,
expandValueEnv
)
-- |The function 'importModules' brings the declarations of all
-- imported interfaces into scope for the current module.
importModules
::
Options
->
Module
->
InterfaceEnv
->
CompilerEnv
importModules
opts
(
Module
mid
_
imps
_
)
iEnv
=
recordExpansion1
opts
=
expandTCValueEnv
opts
$
importUnifyData
$
foldl
importModule
initEnv
imps
where
initEnv
=
(
initCompilerEnv
mid
)
{
aliasEnv
=
importAliases
imps
-- import module aliases
,
labelEnv
=
importLabels
iEnv
imps
-- import record labels
,
interfaceEnv
=
iEnv
-- imported interfaces
}
importModule
env
(
ImportDecl
_
m
q
asM
is
)
=
case
Map
.
lookup
m
iEnv
of
...
...
@@ -98,6 +97,16 @@ importInterface m q is i env = env
ts
=
isVisible
is
(
Set
.
fromList
$
foldr
addType
[]
expandedSpec
)
vs
=
isVisible
is
(
Set
.
fromList
$
foldr
addValue
[]
expandedSpec
)
addType
::
Import
->
[
Ident
]
->
[
Ident
]
addType
(
Import
_
)
tcs
=
tcs
addType
(
ImportTypeWith
tc
_
)
tcs
=
tc
:
tcs
addType
(
ImportTypeAll
_
)
_
=
internalError
"Imports.addType"
addValue
::
Import
->
[
Ident
]
->
[
Ident
]
addValue
(
Import
f
)
fs
=
f
:
fs
addValue
(
ImportTypeWith
_
cs
)
fs
=
cs
++
fs
addValue
(
ImportTypeAll
_
)
_
=
internalError
"Imports.addValue"
isVisible
::
Maybe
ImportSpec
->
Set
.
Set
Ident
->
Ident
->
Bool
isVisible
(
Just
(
Importing
_
_
))
xs
=
(`
Set
.
member
`
xs
)
isVisible
(
Just
(
Hiding
_
_
))
xs
=
(`
Set
.
notMember
`
xs
)
...
...
@@ -185,7 +194,7 @@ bindTy m (INewtypeDecl _ tc tvs nc) env =
bindNewConstr
m
tc'
tvs
(
constrType
tc'
tvs
)
nc
env
where
tc'
=
qualQualify
m
tc
bindTy
m
(
ITypeDecl
_
r
_
(
RecordType
fs
_
))
env
=
foldr
(
bindRecLabel
m
r'
)
env
fs
foldr
(
bindRec
ord
Label
s
m
r'
)
env
fs
where
r'
=
qualifyWith
m
$
fromRecordExtId
$
unqualify
r
bindTy
m
(
IFunctionDecl
_
f
a
ty
)
env
=
Map
.
insert
(
unqualify
f
)
(
Value
(
qualQualify
m
f
)
a
(
polyType
(
toQualType
m
[]
ty
)))
env
...
...
@@ -213,11 +222,15 @@ constrType' m tvs evs ty = ForAllExist (length tvs) (length evs)
qualifyLike
::
QualIdent
->
Ident
->
QualIdent
qualifyLike
x
=
maybe
qualify
qualifyWith
(
qualidMod
x
)
bindRecLabel
::
ModuleIdent
->
QualIdent
->
([
Ident
],
TypeExpr
)
->
ExpValueEnv
->
ExpValueEnv
bindRecLabel
m
r
(
ls
,
ty
)
env
=
foldr
bindL
env
ls
bindRec
ord
Label
s
::
ModuleIdent
->
QualIdent
->
([
Ident
],
TypeExpr
)
->
ExpValueEnv
->
ExpValueEnv
bindRec
ord
Label
s
m
r
(
ls
,
ty
)
env
=
foldr
bindL
bl
env
ls
where
bindL
l
=
Map
.
insert
l
$
Label
(
qualify
l
)
r
$
polyType
$
toQualType
m
[]
ty
bindLbl
l
=
Map
.
insert
l
(
lblInfo
l
)
lblInfo
l
=
Label
(
qualify
l
)
r
(
polyType
$
toQualType
m
[]
ty
)
constrType
::
QualIdent
->
[
Ident
]
->
TypeExpr
constrType
tc
tvs
=
ConstructorType
tc
$
map
VariableType
tvs
-- ---------------------------------------------------------------------------
-- Expansion of the import specification
...
...
@@ -307,40 +320,33 @@ expandHide' m tyEnv f tcImport = case Map.lookup f tyEnv of
expandTypeWith
::
ModuleIdent
->
ExpTCEnv
->
Ident
->
[
Ident
]
->
Import
expandTypeWith
m
tcEnv
tc
cs
=
case
Map
.
lookup
tc
tcEnv
of
Just
(
DataType
_
_
cs'
)
->
ImportTypeWith
tc
(
map
(
checkConstr
[
c
|
Just
(
DataConstr
c
_
_
)
<-
cs'
])
cs
)
Just
(
RenamingType
_
_
(
DataConstr
c
_
_
))
->
ImportTypeWith
tc
(
map
(
checkConstr
[
c
])
cs
)
Just
_
->
errorMessage
$
errNonDataType
tc
Nothing
->
errorMessage
$
errUndefinedEntity
m
tc
Just
(
DataType
_
_
cs'
)
->
ImportTypeWith
tc
$
map
(
checkConstr
[
c
|
Just
(
DataConstr
c
_
_
)
<-
cs'
])
cs
Just
(
RenamingType
_
_
(
DataConstr
c
_
_
))
->
ImportTypeWith
tc
$
map
(
checkConstr
[
c
])
cs
Just
(
AliasType
_
_
(
TypeRecord
fs
_
))
->
ImportTypeWith
tc
$
map
(
checkLabel
[
l
|
(
l
,
_
)
<-
fs
]
.
renameLabel
)
cs
Just
(
AliasType
_
_
_
)
->
errorMessage
$
errNonDataType
tc
Nothing
->
errorMessage
$
errUndefinedEntity
m
tc
where
checkConstr
cs'
c
|
c
`
elem
`
cs'
=
c
|
otherwise
=
errorMessage
$
errUndefinedDataConstr
tc
c
checkConstr
cs'
c
|
c
`
elem
`
cs'
=
c
|
otherwise
=
errorMessage
$
errUndefinedDataConstr
tc
c
checkLabel
ls'
l
|
l
`
elem
`
ls'
=
l
|
otherwise
=
errorMessage
$
errUndefinedLabel
tc
l
expandTypeAll
::
ModuleIdent
->
ExpTCEnv
->
Ident
->
Import
expandTypeAll
m
tcEnv
tc
=
case
Map
.
lookup
tc
tcEnv
of
Just
(
DataType
_
_
cs
)
->
ImportTypeWith
tc
[
c
|
Just
(
DataConstr
c
_
_
)
<-
cs
]
Just
(
RenamingType
_
_
(
DataConstr
c
_
_
))
->
ImportTypeWith
tc
[
c
]
Just
_
->
errorMessage
$
errNonDataType
tc
Nothing
->
errorMessage
$
errUndefinedEntity
m
tc
-- Auxiliary functions:
addType
::
Import
->
[
Ident
]
->
[
Ident
]
addType
(
Import
_
)
tcs
=
tcs
addType
(
ImportTypeWith
tc
_
)
tcs
=
tc
:
tcs
addType
(
ImportTypeAll
_
)
_
=
internalError
"Imports.addType"
addValue
::
Import
->
[
Ident
]
->
[
Ident
]
addValue
(
Import
f
)
fs
=
f
:
fs
addValue
(
ImportTypeWith
_
cs
)
fs
=
cs
++
fs
addValue
(
ImportTypeAll
_
)
_
=
internalError
"Imports.addValue"
constrType
::
QualIdent
->
[
Ident
]
->
TypeExpr
constrType
tc
tvs
=
ConstructorType
tc
$
map
VariableType
tvs
Just
(
DataType
_
_
cs
)
->
ImportTypeWith
tc
[
c
|
Just
(
DataConstr
c
_
_
)
<-
cs
]
Just
(
RenamingType
_
_
(
DataConstr
c
_
_
))
->
ImportTypeWith
tc
[
c
]
Just
(
AliasType
_
_
(
TypeRecord
fs
_
))
->
ImportTypeWith
tc
[
l
|
(
l
,
_
)
<-
fs
]
Just
(
AliasType
_
_
_
)
->
errorMessage
$
errNonDataType
tc
Nothing
->
errorMessage
$
errUndefinedEntity
m
tc
-- ---------------------------------------------------------------------------
...
...
@@ -363,7 +369,7 @@ importUnifyData' tcEnv = fmap (setInfo allTyCons) tcEnv
-- |
qualifyEnv
::
Options
->
CompilerEnv
->
CompilerEnv
qualifyEnv
opts
env
=
recordExpansion2
opts
qualifyEnv
opts
env
=
expandValueEnv
opts
$
qualifyLocal
env
$
foldl
(
flip
importInterfaceIntf
)
initEnv
$
Map
.
elems
...
...
@@ -412,6 +418,10 @@ errUndefinedDataConstr :: Ident -> Ident -> Message
errUndefinedDataConstr
tc
c
=
posErr
c
$
name
c
++
" is not a data constructor of type "
++
name
tc
errUndefinedLabel
::
Ident
->
Ident
->
Message
errUndefinedLabel
tc
c
=
posErr
c
$
name
c
++
" is not a label of record type "
++
name
tc
errNonDataType
::
Ident
->
Message
errNonDataType
tc
=
posErr
tc
$
name
tc
++
" is not a data type"
...
...
src/Records.hs
View file @
2aeb3b59
...
...
@@ -13,145 +13,123 @@
/Note:/ the record types for the current module are expanded within the
type check.
-}
module
Records
where
module
Records
(
expandTCValueEnv
,
expandValueEnv
)
where
import
Data.List
(
find
)
import
qualified
Data.Map
as
Map
(
lookup
,
elems
)
import
Data.Maybe
(
fromMaybe
)
import
Curry.Base.Ident
import
Curry.Syntax
import
Base.CurryTypes
(
toType
)
import
Base.Messages
import
Base.TopEnv
import
Base.Messages
(
internalError
)
import
Base.Types
import
Base.TypeSubst
import
Base.TypeSubst
(
expandAliasType
)
import
Env.Interface
import
Env.Label
import
Env.TypeConstructors
import
Env.Value
import
CompilerEnv
import
CompilerOpts
-- ---------------------------------------------------------------------------
-- Import defined record labels
-- ---------------------------------------------------------------------------
-- Unlike usual identifiers like in functions, types etc., identifiers
-- of labels are always represented unqualified within the whole context
-- of compilation. Since the common type environment (type \texttt{ValueEnv})
-- has some problems with handling imported unqualified identifiers, it is
-- necessary to add the type information for labels seperately. For this reason
-- the function \texttt{importLabels} generates an environment containing
-- all imported labels and the function \texttt{addImportedLabels} adds this
-- content to a value environment.
importLabels
::
InterfaceEnv
->
[
ImportDecl
]
->
LabelEnv
importLabels
mEnv
ds
=
foldl
importLabelTypes
initLabelEnv
ds
where
importLabelTypes
::
LabelEnv
->
ImportDecl
->
LabelEnv
importLabelTypes
lEnv
(
ImportDecl
p
m
_
asM
is
)
=
case
Map
.
lookup
m
mEnv
of
Just
(
Interface
_
_
ds'
)
->
foldl
(
importLabelType
p
(
fromMaybe
m
asM
)
is
)
lEnv
ds'
Nothing
->
internalError
"Records.importLabels"
importLabelType
p
m
is
lEnv
(
ITypeDecl
_
r
_
(
RecordType
fs
_
))
=
foldl
(
insertLabelType
p
m
r'
(
getImportSpec
r'
is
))
lEnv
fs
where
r'
=
qualifyWith
m
(
fromRecordExtId
(
unqualify
r
))
importLabelType
_
_
_
lEnv
_
=
lEnv
insertLabelType
_
_
r
(
Just
(
ImportTypeAll
_
))
lEnv
([
l
],
ty
)
=
bindLabelType
l
r
(
toType
[]
ty
)
lEnv
insertLabelType
_
_
r
(
Just
(
ImportTypeWith
_
ls
))
lEnv
([
l
],
ty
)
|
l
`
elem
`
ls
=
bindLabelType
l
r
(
toType
[]
ty
)
lEnv
|
otherwise
=
lEnv
insertLabelType
_
_
_
_
lEnv
_
=
lEnv
getImportSpec
r
(
Just
(
Importing
_
is'
))
=
find
(
isImported
(
unqualify
r
))
is'
getImportSpec
r
Nothing
=
Just
(
ImportTypeAll
(
unqualify
r
))
getImportSpec
_
_
=
Nothing
isImported
r
(
Import
r'
)
=
r
==
r'
isImported
r
(
ImportTypeWith
r'
_
)
=
r
==
r'
isImported
r
(
ImportTypeAll
r'
)
=
r
==
r'
addImportedLabels
::
ModuleIdent
->
LabelEnv
->
ValueEnv
->
ValueEnv
addImportedLabels
m
lEnv
tyEnv
=
foldr
addLabelType
tyEnv
$
concat
$
Map
.
elems
lEnv
where
addLabelType
(
LabelType
l
r
ty
)
tyEnv'
=
let
m'
=
fromMaybe
m
(
qualidMod
r
)
in
importTopEnv
m'
l
(
Label
(
qualify
l
)
(
qualQualify
m'
r
)
(
polyType
ty
))
tyEnv'
recordExpansion1
::
Options
->
CompilerEnv
->
CompilerEnv
recordExpansion1
opts
env
|
enabled
=
env
{
tyConsEnv
=
tcEnv'
,
valueEnv
=
tyEnv'
}
|
otherwise
=
env
where
enabled
=
Records
`
elem
`
optExtensions
opts
tcEnv'
=
fmap
(
expandRecordTC
tcEnv
)
tcEnv
tyEnv'
=
fmap
(
expandRecordTypes
tcEnv
)
tyEnvLbl
tyEnvLbl
=
addImportedLabels
m
lEnv
tyEnv
m
=
moduleIdent
env
lEnv
=
labelEnv
env
tcEnv
=
tyConsEnv
env
tyEnv
=
valueEnv
env
recordExpansion2
::
Options
->
CompilerEnv
->
CompilerEnv
recordExpansion2
opts
env
|
enabled
=
env
{
valueEnv
=
tyEnv'
}
expandTCValueEnv
::
Options
->
CompilerEnv
->
CompilerEnv
expandTCValueEnv
opts
env
|
enabled
=
env'
{
tyConsEnv
=
tcEnv'
}
|
otherwise
=
env
where
enabled
=
Records
`
elem
`
optExtensions
opts
tyEnv'
=
fmap
(
expandRecordTypes
tcEnv
)
tyEnvLbl
tyEnvLbl
=
addImportedLabels
m
lEnv
tyEnv
m
=
moduleIdent
env
lEnv
=
labelEnv
env
tcEnv
=
tyConsEnv
env
tyEnv
=
valueEnv
env
enabled
=
Records
`
elem
`
optExtensions
opts
tcEnv'
=
fmap
(
expandRecordTC
tcEnv
)
tcEnv
tcEnv
=
tyConsEnv
env'
env'
=
expandValueEnv
opts
env
expandRecordTC
::
TCEnv
->
TypeInfo
->
TypeInfo
expandRecordTC
tcEnv
(
DataType
qid
n
args
)
=
DataType
qid
n
(
map
(
maybe
Nothing
(
Just
.
(
expandData
tcEnv
)))
args
)
expandRecordTC
tcEnv
(
RenamingType
qid
n
(
DataConstr
ident
m
[
ty
]))
=
RenamingType
qid
n
(
DataConstr
ident
m
[
expandRecords
tcEnv
ty
])
expandRecordTC
_
(
RenamingType
_
_
(
DataConstr
_
_
_
))
=
DataType
qid
n
$
map
(
fmap
expandData
)
args
where
expandData
(
DataConstr
c
m
tys
)
=
DataConstr
c
m
$
map
(
expandRecords
tcEnv
)
tys
expandRecordTC
tcEnv
(
RenamingType
qid
n
(
DataConstr
c
m
[
ty
]))
=
RenamingType
qid
n
(
DataConstr
c
m
[
expandRecords
tcEnv
ty
])
expandRecordTC
_
(
RenamingType
_
_
(
DataConstr
_
_
_
))
=
internalError
"Records.expandRecordTC"
expandRecordTC
tcEnv
(
AliasType
qid
n
ty
)
=
AliasType
qid
n
(
expandRecords
tcEnv
ty
)
expandData
::
TCEnv
->
DataConstr
->
DataConstr
expandData
tcEnv
(
DataConstr
ident
n
tys
)
=
DataConstr
ident
n
(
map
(
expandRecords
tcEnv
)
tys
)
expandValueEnv
::
Options
->
CompilerEnv
->
CompilerEnv
expandValueEnv
opts
env
|
enabled
=
env
{
valueEnv
=
tyEnv'
}
|
otherwise
=
env
where
tcEnv
=
tyConsEnv
env
tyEnv
=
valueEnv
env
enabled
=
Records
`
elem
`
optExtensions
opts
tyEnv'
=
fmap
(
expandRecordTypes
tcEnv
)
tyEnv
-- $ addImportedLabels m lEnv tyEnv
-- m = moduleIdent env
-- lEnv = labelEnv env
expandRecordTypes
::
TCEnv
->
ValueInfo
->
ValueInfo
expandRecordTypes
tcEnv
(
DataConstructor
qid
a
rty
(
ForAllExist
n
m
ty
))
=
DataConstructor
qid
a
rty
(
ForAllExist
n
m
(
expandRecords
tcEnv
ty
))
expandRecordTypes
tcEnv
(
DataConstructor
qid
a
(
ForAllExist
n
m
ty
))
=
DataConstructor
qid
a
(
ForAllExist
n
m
(
expandRecords
tcEnv
ty
))
expandRecordTypes
tcEnv
(
NewtypeConstructor
qid
(
ForAllExist
n
m
ty
))
=
NewtypeConstructor
qid
(
ForAllExist
n
m
(
expandRecords
tcEnv
ty
))
expandRecordTypes
tcEnv
(
Value
qid
a
rty
(
ForAll
n
ty
))
=
Value
qid
a
rty
(
ForAll
n
(
expandRecords
tcEnv
ty
))
expandRecordTypes
tcEnv
(
Value
qid
a
(
ForAll
n
ty
))
=
Value
qid
a
(
ForAll
n
(
expandRecords
tcEnv
ty
))
expandRecordTypes
tcEnv
(
Label
qid
r
(
ForAll
n
ty
))
=
Label
qid
r
(
ForAll
n
(
expandRecords
tcEnv
ty
))
expandRecords
::
TCEnv
->
Type
->
Type
expandRecords
tcEnv
(
TypeConstructor
qid
tys
)
=
case
qualLookupTC
qid
tcEnv
of
[
AliasType
_
_
rty
@
(
TypeRecord
_
_
)]
->
expandRecords
tcEnv
(
expandAliasType
(
map
(
expandRecords
tcEnv
)
tys
)
rty
)
_
->
TypeConstructor
qid
(
map
(
expandRecords
tcEnv
)
tys
)
expandRecords
tcEnv
(
TypeConstructor
qid
tys
)
=
case
qualLookupTC
qid
tcEnv
of
[
AliasType
_
_
rty
@
(
TypeRecord
_
_
)]
->
expandRecords
tcEnv
$
expandAliasType
(
map
(
expandRecords
tcEnv
)
tys
)
rty
_
->
TypeConstructor
qid
$
map
(
expandRecords
tcEnv
)
tys
expandRecords
tcEnv
(
TypeConstrained
tys
v
)
=
TypeConstrained
(
map
(
expandRecords
tcEnv
)
tys
)
v
expandRecords
tcEnv
(
TypeArrow
ty1
ty2
)
=
TypeArrow
(
expandRecords
tcEnv
ty1
)
(
expandRecords
tcEnv
ty2
)
expandRecords
tcEnv
(
TypeRecord
fs
rv
)
=
TypeRecord
(
map
(
\
(
l
,
ty
)
->
(
l
,
expandRecords
tcEnv
ty
))
fs
)
rv
TypeRecord
(
map
(
\
(
l
,
ty
)
->
(
l
,
expandRecords
tcEnv
ty
))
fs
)
rv
expandRecords
_
ty
=
ty
-- ---------------------------------------------------------------------------
-- Import defined record labels
-- ---------------------------------------------------------------------------
-- Unlike usual identifiers like in functions, types etc., identifiers
-- of labels are always represented unqualified within the whole context
-- of compilation. Since the common type environment (type \texttt{ValueEnv})
-- has some problems with handling imported unqualified identifiers, it is
-- necessary to add the type information for labels seperately. For this reason
-- the function \texttt{importLabels} generates an environment containing
-- all imported labels and the function \texttt{addImportedLabels} adds this
-- content to a value environment.
-- importLabels :: InterfaceEnv -> [ImportDecl] -> LabelEnv
-- importLabels mEnv ds = foldl importLabelTypes initLabelEnv ds
-- where
-- importLabelTypes :: LabelEnv -> ImportDecl -> LabelEnv
-- importLabelTypes lEnv (ImportDecl _ m _ asM is) = case Map.lookup m mEnv of
-- Just (Interface _ _ ds') ->
-- foldl (importLabelType (fromMaybe m asM) is) lEnv ds'
-- Nothing ->
-- internalError "Records.importLabels"
--
-- importLabelType m is lEnv (ITypeDecl _ r _ (RecordType fs _)) =
-- foldl (insertLabelType r' (getImportSpec r' is)) lEnv fs
-- where r' = qualifyWith m $ fromRecordExtId $ unqualify r
-- importLabelType _ _ lEnv _ = lEnv
--
-- insertLabelType r (Just (ImportTypeAll _)) lEnv ([l], ty) =
-- bindLabelType l r (toType [] ty) lEnv
-- insertLabelType r (Just (ImportTypeWith _ ls)) lEnv ([l], ty)
-- | l `elem` ls = bindLabelType l r (toType [] ty) lEnv
-- | otherwise = lEnv
-- insertLabelType _ _ lEnv _ = lEnv
--
-- getImportSpec r (Just (Importing _ is')) = find (isImported (unqualify r)) is'
-- getImportSpec r Nothing = Just $ ImportTypeAll $ unqualify r
-- getImportSpec _ _ = Nothing
--
-- isImported r (Import r' ) = r == r'
-- isImported r (ImportTypeWith r' _) = r == r'
-- isImported r (ImportTypeAll r' ) = r == r'
-- addImportedLabels :: ModuleIdent -> LabelEnv -> ValueEnv -> ValueEnv
-- addImportedLabels m lEnv tyEnv =
-- foldr addLabelType tyEnv (concat $ Map.elems lEnv)
-- where
-- addLabelType (LabelType l r ty) = importTopEnv m' l lblInfo
-- where lblInfo = Label (qualify l) (qualQualify m' r) (polyType ty)
-- m' = fromMaybe m (qualidMod r)
test/RecordTest.curry
View file @
2aeb3b59
...
...
@@ -3,4 +3,8 @@ module RecordTest where
type Record =
{ intField :: Int
, boolField :: Bool
}
\ No newline at end of file
}
empty = { intField = 0, boolField = False }
full = { intField = 1, boolField = True }
\ No newline at end of file
test/RecordTest2.curry
0 → 100644
View file @
2aeb3b59
module RecordTest2 where
import RecordTest (Record(boolField))
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