Skip to content
GitLab
Menu
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
4b7dc029
Commit
4b7dc029
authored
Apr 02, 2016
by
Laszlo Domoszlai
Browse files
make strictness propagation work without Flavour
parent
9f0a3584
Changes
3
Hide whitespace changes
Inline
Side-by-side
src/Sapl/Optimization/StrictnessPropagation.dcl
View file @
4b7dc029
...
...
@@ -2,4 +2,9 @@ definition module Sapl.Optimization.StrictnessPropagation
import
Sapl
.
SaplParser
,
Sapl
.
Target
.
Flavour
doStrictnessPropagation
::
!
ParserState
!
Flavour
![
FuncType
]
->
(![
FuncType
],
!
ParserState
)
::
IsStrictArgFun
:==
!
ParserState
!
String
!
Int
!
Int
->
Bool
// strict argument checker for Flavour file
isStrictArgFlavour
::
!
Flavour
!
ParserState
!
String
!
Int
!
Int
->
Bool
doStrictnessPropagation
::
!
ParserState
!
IsStrictArgFun
![
FuncType
]
->
(![
FuncType
],
!
ParserState
)
src/Sapl/Optimization/StrictnessPropagation.icl
View file @
4b7dc029
...
...
@@ -7,7 +7,8 @@ from Data.Set import :: Set, newSet, fromList, member, insert, delete, union, un
from
Data
.
Map
import
get
,
put
import
Data
.
Maybe
isStrictArg
{
ps_constructors
,
ps_functions
}
{
builtInFunctions
,
inlineFunctions
}
n
nr_args
i
isStrictArgFlavour
::
!
Flavour
!
ParserState
!
String
!
Int
!
Int
->
Bool
isStrictArgFlavour
{
builtInFunctions
,
inlineFunctions
}
{
ps_constructors
,
ps_functions
}
n
nr_args
i
=
checkCons
where
checkCons
=
case
get
n
ps_constructors
of
...
...
@@ -22,19 +23,19 @@ where
(
Just
def
)
=
if
(
nr_args
<
def
.
arity
||
i
>=
def
.
arity
)
False
(
def
.
strictness
.[
i
]
==
'1'
)
=
False
doStrictnessPropagation
::
!
ParserState
!
Flavour
![
FuncType
]
->
(![
FuncType
],
!
ParserState
)
doStrictnessPropagation
ps
flavour
funs
#
(
nfs
,
nps
)
=
foldl
(\(
nfs
,
ps
)
f
->
let
(
nf
,
nps
)
=
propFunc
ps
flavour
f
in
([
nf
:
nfs
],
nps
))
([],
ps
)
funs
doStrictnessPropagation
::
!
ParserState
!
IsStrictArgFun
![
FuncType
]
->
(![
FuncType
],
!
ParserState
)
doStrictnessPropagation
ps
isStrictArg
funs
#
(
nfs
,
nps
)
=
foldl
(\(
nfs
,
ps
)
f
->
let
(
nf
,
nps
)
=
propFunc
ps
isStrictArg
f
in
([
nf
:
nfs
],
nps
))
([],
ps
)
funs
=
(
reverse
nfs
,
nps
)
// TODO: if strictness is given to the arguments the whole propogation stuff
// should be recomputed again and again until a fixpoint...
// Expect: if the functions are in the good order which is the case if the code is linked
propFunc
::
!
ParserState
!
Flavour
!
FuncType
->
(!
FuncType
,
!
ParserState
)
propFunc
ps
=:{
ps_functions
}
flavour
(
FTFunc
name
body
args
)
propFunc
::
!
ParserState
!
IsStrictArgFun
!
FuncType
->
(!
FuncType
,
!
ParserState
)
propFunc
ps
=:{
ps_functions
}
isStrictArg
(
FTFunc
name
body
args
)
=
(
FTFunc
name
nbody
nargs
,
{
ps
&
ps_functions
=
put
(
unpackVar
name
)
nargs
ps_functions
})
where
(
ds
,
nbody
)
=
(
propBody
ps
flavour
newSet
body
)
(
ds
,
nbody
)
=
(
propBody
ps
isStrictArg
newSet
body
)
nargs
=
map
addStrictness
args
addStrictness
var
=:(
TypedVar
(
StrictVar
_
_)
_)
=
var
...
...
@@ -42,8 +43,8 @@ where
propFunc
ps
_
f
=
(
f
,
ps
)
propBody
::
!
ParserState
!
Flavour
!(
Set
String
)
!
SaplTerm
->
(!
Set
String
,
!
SaplTerm
)
propBody
ps
flavour
sd
body
=
walk
sd
body
propBody
::
!
ParserState
!
IsStrictArgFun
!(
Set
String
)
!
SaplTerm
->
(!
Set
String
,
!
SaplTerm
)
propBody
ps
isStrictArg
sd
body
=
walk
sd
body
where
walk
sd
t
=:(
SVar
var
)
=
(
insert
(
unpackVar
var
)
sd
,
t
)
...
...
@@ -59,7 +60,7 @@ where
where
varName
=
unpackVar
var
nr_args
=
length
args
checkArg
(
arg
,
i
)
=
isStrictArg
ps
flavour
varName
nr_args
i
checkArg
(
arg
,
i
)
=
isStrictArg
ps
varName
nr_args
i
strictArgs
=
map
fst
(
filter
checkArg
(
zip2
args
[
0
..]))
// We can skip the new expr, cannot contain let definitions...
...
...
src/Sapl/Target/JS/CodeGeneratorJS.icl
View file @
4b7dc029
...
...
@@ -720,7 +720,7 @@ generateJS f tramp saplsrc mbPst
#
pts
=
tokensWithPositions
saplsrc
=
case
parse
pts
of
Ok
(
funcs
,
s
)
#
newpst
=
mergeParserStates
s
mbPst
#
(
funcs
,
newpst
)
=
if
(
isSet
f
"enableStrictnessPropagation"
)
(
doStrictnessPropagation
newpst
f
funcs
)
(
funcs
,
newpst
)
#
(
funcs
,
newpst
)
=
if
(
isSet
f
"enableStrictnessPropagation"
)
(
doStrictnessPropagation
newpst
(
isStrictArgFlavour
f
)
funcs
)
(
funcs
,
newpst
)
#
state
=
newState
f
tramp
newpst
#
a
=
newAppender
<++
"
\"
use strict
\"
;"
#
a
=
a
<++
"/*Trampoline: "
...
...
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