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
12ad07b9
Commit
12ad07b9
authored
May 20, 2016
by
Björn Peemöller
Browse files
Removed package dependency to multimap due to compatibility issues
parent
5e96edc8
Changes
2
Hide whitespace changes
Inline
Side-by-side
curry-frontend.cabal
View file @
12ad07b9
...
...
@@ -43,7 +43,6 @@ Library
, directory
, filepath
, mtl
, multimap
, process
, syb
, transformers
...
...
src/Checks/SyntaxCheck.hs
View file @
12ad07b9
...
...
@@ -28,13 +28,14 @@ module Checks.SyntaxCheck (syntaxCheck) where
#
if
__GLASGOW_HASKELL__
<
710
import
Control.Applicative
((
<$>
),
(
<*>
))
#
endif
import
Control.Monad
(
unless
,
when
)
import
Control.Monad
(
unless
,
when
)
import
qualified
Control.Monad.State
as
S
(
State
,
runState
,
gets
,
modify
)
import
Data.List
(
insertBy
,
intersect
,
nub
,
partition
)
import
qualified
Data.Map
as
Map
(
fromList
,
lookup
)
import
Data.Maybe
(
isJust
,
isNothing
,
fromMaybe
)
import
qualified
Data.Set
as
Set
(
empty
,
insert
,
member
,
toList
)
import
qualified
Data.SetMap
as
SMap
(
SetMap
,
(
!
),
empty
,
insert
,
keys
)
import
Data.List
(
insertBy
,
intersect
,
nub
,
partition
)
import
qualified
Data.Map
as
Map
(
Map
,
empty
,
findWithDefault
,
fromList
,
insertWith
,
keys
)
import
Data.Maybe
(
isJust
,
isNothing
)
import
qualified
Data.Set
as
Set
(
Set
,
empty
,
insert
,
member
,
singleton
,
union
,
toList
)
import
Curry.Base.Ident
import
Curry.Base.Position
...
...
@@ -194,41 +195,39 @@ data FuncDeps = FuncDeps
,
globalDeps
::
GlobalDeps
,
funcPats
::
[(
QualIdent
,
QualIdent
)]
}
type
GlobalDeps
=
S
Map
.
Set
Map
QualIdent
QualIdent
type
GlobalDeps
=
Map
.
Map
QualIdent
(
Set
.
Set
QualIdent
)
-- |Initial state for FuncDeps
noFuncDeps
::
FuncDeps
noFuncDeps
=
FuncDeps
Nothing
S
Map
.
empty
[]
noFuncDeps
=
FuncDeps
Nothing
Map
.
empty
[]
-- |Perform an action inside a function, settìng `curGlobalFunc' to that function
inFunc
::
Ident
->
SCM
a
->
SCM
a
inFunc
i
scm
=
do
m
<-
getModuleIdent
let
f
=
qualifyWith
m
i
m
<-
getModuleIdent
global
<-
isNothing
<$>
S
.
gets
(
curGlobalFunc
.
funcDeps
)
when
global
$
modifyFuncDeps
$
\
fd
->
fd
{
curGlobalFunc
=
Just
f
}
re
t
<-
scm
when
global
$
modifyFuncDeps
$
\
fd
->
fd
{
curGlobalFunc
=
Just
(
qualifyWith
m
i
)
}
re
s
<-
scm
when
global
$
modifyFuncDeps
$
\
fd
->
fd
{
curGlobalFunc
=
Nothing
}
return
re
t
return
re
s
-- |Add a dependency to `curGlobalFunction'
addGlobalDep
::
QualIdent
->
SCM
()
addGlobalDep
dep
=
do
maybeF
<-
S
.
gets
(
curGlobalFunc
.
funcDeps
)
when
(
isNothing
maybeF
)
$
internalError
"SyntaxCheck.addGlobalDep: no global function set"
let
Just
f
=
maybeF
modifyFuncDeps
$
\
fd
->
fd
{
globalDeps
=
SMap
.
insert
f
dep
(
globalDeps
fd
)
}
case
maybeF
of
Nothing
->
internalError
"SyntaxCheck.addFuncPat: no global function set"
Just
f
->
modifyFuncDeps
$
\
fd
->
fd
{
globalDeps
=
Map
.
insertWith
(
Set
.
union
)
f
(
Set
.
singleton
dep
)
(
globalDeps
fd
)
}
-- |Add a functional pattern to `curGlobalFunction'
addFuncPat
::
QualIdent
->
SCM
()
addFuncPat
fp
=
do
maybeF
<-
S
.
gets
(
curGlobalFunc
.
funcDeps
)
when
(
isNothing
maybeF
)
$
internalError
"SyntaxCheck.addFuncPat: no global function set"
let
Just
f
=
maybeF
modifyFuncDeps
$
\
fd
->
fd
{
funcPats
=
(
fp
,
f
)
:
funcPats
fd
}
case
maybeF
of
Nothing
->
internalError
"SyntaxCheck.addFuncPat: no global function set"
Just
f
->
modifyFuncDeps
$
\
fd
->
fd
{
funcPats
=
(
fp
,
f
)
:
funcPats
fd
}
-- |Return dependencies of global functions
getGlobalDeps
::
SCM
GlobalDeps
...
...
@@ -418,16 +417,17 @@ checkExtension (UnknownExtension p e) = report $ errUnknownExtension p e
-- |(depends on its own global function)
checkFuncPatDeps
::
SCM
()
checkFuncPatDeps
=
do
fps
<-
getFuncPats
deps
<-
getGlobalDeps
let
depLists
=
scc
(
:
[]
)
(
Set
.
toList
.
(
SMap
.!
)
deps
)
(
SMap
.
keys
deps
)
levelList
=
concat
$
zipWith
(
\
l
n
->
zip
l
(
repeat
n
))
depLists
[
1
..
]
levels
=
Map
.
fromList
levelList
funcLevel
f
=
fromMaybe
0
$
Map
.
lookup
f
levels
::
Integer
mapM_
(
checkFuncPatDep
funcLevel
)
fps
fps
<-
getFuncPats
deps
<-
getGlobalDeps
let
levels
=
scc
(
:
[]
)
(
\
k
->
Set
.
toList
(
Map
.
findWithDefault
(
Set
.
empty
)
k
deps
))
(
Map
.
keys
deps
)
levelMap
=
Map
.
fromList
[
(
f
,
l
)
|
(
fs
,
l
)
<-
zip
levels
[
1
..
],
f
<-
fs
]
level
f
=
Map
.
findWithDefault
(
0
::
Int
)
f
levelMap
mapM_
(
checkFuncPatDep
level
)
fps
checkFuncPatDep
::
Ord
a
=>
(
QualIdent
->
a
)
->
(
QualIdent
,
QualIdent
)
->
SCM
()
checkFuncPatDep
funcL
evel
(
fp
,
f
)
=
unless
(
funcL
evel
fp
<
funcL
evel
f
)
$
checkFuncPatDep
l
evel
(
fp
,
f
)
=
unless
(
l
evel
fp
<
l
evel
f
)
$
report
$
errFuncPatCyclic
fp
f
checkTopDecls
::
[
Decl
]
->
SCM
[
Decl
]
...
...
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