Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
7
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
curry
curry-frontend
Commits
ff313cf9
Commit
ff313cf9
authored
Sep 06, 2013
by
Björn Peemöller
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Integration of language pragmas
parent
07a4de3f
Changes
5
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
48 additions
and
27 deletions
+48
-27
src/Checks.hs
src/Checks.hs
+3
-4
src/Checks/SyntaxCheck.lhs
src/Checks/SyntaxCheck.lhs
+28
-15
src/CurryDeps.hs
src/CurryDeps.hs
+10
-8
test/PragmaError.curry
test/PragmaError.curry
+3
-0
test/PragmaRecords.curry
test/PragmaRecords.curry
+4
-0
No files found.
src/Checks.hs
View file @
ff313cf9
...
...
@@ -53,11 +53,10 @@ kindCheck _ env (Module ps m es is ds)
-- disambiguated, variables are renamed
-- * Environment: remains unchanged
syntaxCheck
::
Monad
m
=>
Check
m
Module
syntaxCheck
opts
env
(
Module
ps
m
es
is
ds
)
|
null
msgs
=
right
(
env
,
Module
ps
m
es
is
ds
'
)
syntaxCheck
opts
env
mdl
|
null
msgs
=
right
(
env
,
mdl
'
)
|
otherwise
=
left
msgs
where
(
ds'
,
msgs
)
=
SC
.
syntaxCheck
opts
(
moduleIdent
env
)
(
valueEnv
env
)
(
tyConsEnv
env
)
ds
where
(
mdl'
,
msgs
)
=
SC
.
syntaxCheck
opts
(
valueEnv
env
)
(
tyConsEnv
env
)
mdl
-- |Check the precedences of infix operators.
--
...
...
src/Checks/SyntaxCheck.lhs
View file @
ff313cf9
...
...
@@ -56,14 +56,13 @@ generated. Finally, all declarations are checked within the resulting
environment. In addition, this process will also rename the local variables.
\begin{verbatim}
>
syntaxCheck
::
Options
->
ModuleIdent
->
ValueEnv
->
TCEnv
->
[
Decl
]
>
->
([
Decl
],
[
Message
])
>
syntaxCheck
opts
m
tyEnv
tcEnv
decls
=
>
syntaxCheck
::
Options
->
ValueEnv
->
TCEnv
->
Module
->
(
Module
,
[
Message
])
>
syntaxCheck
opts
tyEnv
tcEnv
mdl
@
(
Module
_
m
_
_
ds
)
=
>
case
findMultiples
$
concatMap
constrs
typeDecls
of
>
[]
->
runSC
(
checkModule
decls
)
state
>
css
->
(
decls
,
map
errMultipleDataConstructor
css
)
>
[]
->
runSC
(
checkModule
mdl
)
state
>
css
->
(
mdl
,
map
errMultipleDataConstructor
css
)
>
where
>
typeDecls
=
filter
isTypeDecl
d
ecl
s
>
typeDecls
=
filter
isTypeDecl
ds
>
rEnv
=
globalEnv
$
fmap
(
renameInfo
tcEnv
)
tyEnv
>
state
=
initState
(
optExtensions
opts
)
m
rEnv
...
...
@@ -316,13 +315,23 @@ a goal. Note that all declarations in the goal must be considered as
local declarations.
\begin{verbatim}
>
checkModule
::
[
Decl
]
->
SCM
[
Decl
]
>
checkModule
decls
=
do
>
checkModule
::
Module
->
SCM
Module
>
checkModule
(
Module
ps
m
es
is
decls
)
=
do
>
mapM_
checkPragma
ps
>
mapM_
bindTypeDecl
(
rds
++
dds
)
>
liftM2
(
++
)
(
mapM
checkTypeDecl
tds
)
(
checkTopDecls
vds
)
>
decls'
<-
liftM2
(
++
)
(
mapM
checkTypeDecl
tds
)
(
checkTopDecls
vds
)
>
return
$
Module
ps
m
es
is
decls'
>
where
(
tds
,
vds
)
=
partition
isTypeDecl
decls
>
(
rds
,
dds
)
=
partition
isRecordDecl
tds
>
checkPragma
::
ModulePragma
->
SCM
()
>
checkPragma
(
LanguagePragma
_
exts
)
=
mapM_
checkExtension
exts
>
checkPragma
(
OptionsPragma
_
_
_
)
=
ok
>
checkExtension
::
Extension
->
SCM
()
>
checkExtension
(
KnownExtension
_
e
)
=
enableExtension
e
>
checkExtension
(
UnknownExtension
p
e
)
=
report
$
errUnknownExtension
p
e
>
checkTypeDecl
::
Decl
->
SCM
Decl
>
checkTypeDecl
rec
@
(
TypeDecl
_
r
_
(
RecordType
fs
rty
))
=
do
>
checkRecordExtension
$
idPosition
r
...
...
@@ -980,22 +989,22 @@ Miscellaneous functions.
\begin{verbatim}
>
checkFuncPatsExtension
::
Position
->
SCM
()
>
checkFuncPatsExtension
p
=
checkExtension
p
>
checkFuncPatsExtension
p
=
check
Used
Extension
p
>
"Functional Patterns"
FunctionalPatterns
>
checkRecordExtension
::
Position
->
SCM
()
>
checkRecordExtension
p
=
checkExtension
p
"Records"
Records
>
checkRecordExtension
p
=
check
Used
Extension
p
"Records"
Records
>
checkAnonFreeVarsExtension
::
Position
->
SCM
()
>
checkAnonFreeVarsExtension
p
=
checkExtension
p
>
checkAnonFreeVarsExtension
p
=
check
Used
Extension
p
>
"Anonymous free variables"
AnonFreeVars
>
checkExtension
::
Position
->
String
->
KnownExtension
->
SCM
()
>
checkExtension
pos
msg
ext
=
do
>
check
Used
Extension
::
Position
->
String
->
KnownExtension
->
SCM
()
>
check
Used
Extension
pos
msg
ext
=
do
>
enabled
<-
hasExtension
ext
>
unless
enabled
$
do
>
report
$
errMissingLanguageExtension
pos
msg
ext
>
enableExtension
ext
>
enableExtension
ext
-- to avoid multiple warnings
>
typeArity
::
TypeExpr
->
Int
>
typeArity
(
ArrowType
_
t2
)
=
1
+
typeArity
t2
...
...
@@ -1122,6 +1131,10 @@ Error messages.
>
[
"Expexting"
,
escName
anonId
,
"after"
,
escName
(
mkIdent
"|"
)
>
,
"in the record pattern"
]
>
errUnknownExtension
::
Position
->
String
->
Message
>
errUnknownExtension
p
e
=
posMessage
p
$
>
text
"Unknown language extension:"
<+>
text
e
>
errMissingLanguageExtension
::
Position
->
String
->
KnownExtension
->
Message
>
errMissingLanguageExtension
p
what
ext
=
posMessage
p
$
>
text
what
<+>
text
"are not supported in standard Curry."
$+$
...
...
src/CurryDeps.hs
View file @
ff313cf9
...
...
@@ -29,7 +29,8 @@ import Curry.Base.Pretty
import
Curry.Files.Filenames
import
Curry.Files.PathUtils
import
Curry.Syntax
(
Module
(
..
),
ImportDecl
(
..
),
parseHeader
,
patchModuleId
)
(
Module
(
..
),
ImportDecl
(
..
),
parseHeader
,
patchModuleId
,
hasLanguageExtension
)
import
Base.Messages
import
Base.SCC
(
scc
)
...
...
@@ -90,20 +91,21 @@ sourceDeps opts sEnv fn = readHeader fn >>= moduleDeps opts sEnv fn
-- |Retrieve the dependencies of a given module
moduleDeps
::
Options
->
SourceEnv
->
FilePath
->
Module
->
CYIO
SourceEnv
moduleDeps
opts
sEnv
fn
(
Module
_
m
_
is
_
)
=
case
Map
.
lookup
m
sEnv
of
moduleDeps
opts
sEnv
fn
mdl
@
(
Module
_
m
_
_
_
)
=
case
Map
.
lookup
m
sEnv
of
Just
_
->
return
sEnv
Nothing
->
do
let
imps
=
imports
opts
m
is
let
imps
=
imports
opts
m
dl
sEnv'
=
Map
.
insert
m
(
Source
fn
imps
)
sEnv
foldM
(
moduleIdentDeps
opts
)
sEnv'
imps
-- |Retrieve the imported modules and add the import of the Prelude
-- according to the compiler options.
imports
::
Options
->
ModuleIdent
->
[
ImportDecl
]
->
[
ModuleIdent
]
imports
opts
m
ds
=
nub
$
[
preludeMIdent
|
m
/=
preludeMIdent
&&
implicitPrelude
]
++
[
m'
|
ImportDecl
_
m'
_
_
_
<-
ds
]
where
implicitPrelude
=
NoImplicitPrelude
`
notElem
`
optExtensions
opts
imports
::
Options
->
Module
->
[
ModuleIdent
]
imports
opts
mdl
@
(
Module
_
m
_
is
_
)
=
nub
$
[
preludeMIdent
|
m
/=
preludeMIdent
&&
not
noImplicitPrelude
]
++
[
m'
|
ImportDecl
_
m'
_
_
_
<-
is
]
where
noImplicitPrelude
=
NoImplicitPrelude
`
elem
`
optExtensions
opts
||
mdl
`
hasLanguageExtension
`
NoImplicitPrelude
-- |Retrieve the dependencies for a given 'ModuleIdent'
moduleIdentDeps
::
Options
->
SourceEnv
->
ModuleIdent
->
CYIO
SourceEnv
...
...
test/PragmaError.curry
0 → 100644
View file @
ff313cf9
{-# LANGUAGE ERROR #-}
module PragmaError where
test/PragmaRecords.curry
0 → 100644
View file @
ff313cf9
{-# LANGUAGE Records #-}
module PragmaRecords where
type Rec = { bool :: Bool, int :: Int }
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