Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
clean-and-itasks
clean-sapl
Commits
a995c064
Commit
a995c064
authored
May 02, 2016
by
Laszlo Domoszlai
Browse files
add missing files
parent
074e8d03
Changes
2
Hide whitespace changes
Inline
Side-by-side
src/Sapl/Transform/TailRecursion.dcl
0 → 100644
View file @
a995c064
definition
module
Sapl
.
Transform
.
TailRecursion
import
Data
.
Maybe
from
Sapl
.
SaplStruct
import
::
SaplTypedVar
,
::
SaplTerm
// Topological sort of the let definitions. Returns Nothing if a cycle is detected
sortSetters
::
![(
SaplTypedVar
,
SaplTerm
)]
->
Maybe
[(
SaplTypedVar
,
SaplTerm
)]
src/Sapl/Transform/TailRecursion.icl
0 → 100644
View file @
a995c064
implementation
module
Sapl
.
Transform
.
TailRecursion
import
StdList
,
StdFunc
,
StdTuple
,
StdBool
import
Sapl
.
SaplStruct
from
Data
.
Set
import
qualified
newSet
,
fromList
,
toList
,
member
,
difference
,
insert
,
filter
,
delete
,
null
from
Data
.
Set
import
::
Set
from
Data
.
Map
import
qualified
fromList
,
get
instance
==
SaplVar
where
(==)
a
b
=
eqVarByNameLevel
a
b
instance
<
SaplVar
where
(<)
a
b
=
ltVarByNameLevel
a
b
// Generate the graph: edges and the start nodes (independent nodes)
genGraph
::
!(
Set
SaplVar
)
![(
SaplTypedVar
,
SaplTerm
)]
->
(!
Set
(
SaplVar
,
SaplVar
),
!
Set
SaplVar
)
genGraph
binds
defs
=
foldl
(\
s
(
TypedVar
bv
_,
body
)
->
gen
binds
bv
s
body
)
('
Data
.
Set
'.
newSet
,
binds
)
defs
where
gen
vs
bv
s
(
SSelect
expr
_
idx
)
=
gen
vs
bv
s
expr
gen
vs
bv
s
(
SUpdate
expr
_
updates
)
=
foldl
(
gen
vs
bv
)
(
gen
vs
bv
s
expr
)
(
map
snd
updates
)
gen
vs
bv
s
(
SApplication
(
SVar
f
)
as
)
=
foldl
(
gen
vs
bv
)
s
[
SVar
f
:
as
]
gen
vs
bv
s
(
SApplication
expr
as
)
=
foldl
(
gen
vs
bv
)
(
gen
vs
bv
s
expr
)
as
gen
vs
bv
(
es
,
is
)
(
SVar
v
)
|
'
Data
.
Set
'.
member
v
vs
&&
v
<>
bv
=
('
Data
.
Set
'.
insert
(
bv
,
v
)
es
,
'
Data
.
Set
'.
delete
v
is
)
gen
_
_
s
_
=
s
// Kahn, Arthur B. (1962), "Topological sorting of large networks"
sortSetters
::
![(
SaplTypedVar
,
SaplTerm
)]
->
Maybe
[(
SaplTypedVar
,
SaplTerm
)]
sortSetters
[
d
]
=
Just
[
d
]
sortSetters
defs
#
(
redges
,
rordbinds
)
=
gen
edges
('
Data
.
Set
'.
toList
startnodes
)
|
'
Data
.
Set
'.
null
redges
=
Just
(
map
(\
k
->
fromJust
('
Data
.
Map
'.
get
k
defmap
))
(
reverse
rordbinds
))
=
Nothing
// cycle is detected
where
(
edges
,
startnodes
)
=
genGraph
binds
defs
binds
=
'
Data
.
Set
'.
fromList
(
map
(
removeTypeInfo
o
toNormalVar
o
fst
)
defs
)
defmap
=
'
Data
.
Map
'.
fromList
(
map
(\
d
=:(
bv
,
body
)
->
(
removeTypeInfo
bv
,
d
))
defs
)
// Returns the renaming edges (if any) and the ordered list of bind vars (reversed order)
gen
edges
[]
=
(
edges
,
[])
gen
edges
[
n
:
ns
]
=
let
(
redges
,
rout
)
=
gen
nedges
(
nns
++
ns
)
in
(
redges
,[
n
:
rout
])
where
(
nedges
,
nns
)
=
foldl
peredge
(
edges
,[])
outedges
outedges
=
filter
(\
e
=
fst
e
==
n
)
('
Data
.
Set
'.
toList
edges
)
peredge
(
edges
,
out
)
e
=:(
n
,
m
)
#
edges
=
'
Data
.
Set
'.
delete
e
edges
|
'
Data
.
Set
'.
null
('
Data
.
Set
'.
filter
(\
e
=
snd
e
==
m
)
edges
)
=
(
edges
,
[
m
:
out
])
=
(
edges
,
out
)
\ No newline at end of file
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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