Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
C
clean-sapl
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
2
Issues
2
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
clean-and-itasks
clean-sapl
Commits
83c511af
Commit
83c511af
authored
Oct 30, 2017
by
Steffen Michels
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
fixed imports of Data.Map and removed dependency on Data.Void
parent
d1d7aa7f
Changes
6
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
19 additions
and
18 deletions
+19
-18
src/Sapl/SaplParser.dcl
src/Sapl/SaplParser.dcl
+2
-2
src/Sapl/SaplParser.icl
src/Sapl/SaplParser.icl
+4
-4
src/Sapl/SaplStruct.icl
src/Sapl/SaplStruct.icl
+1
-1
src/Sapl/Target/JS/CodeGeneratorJS.icl
src/Sapl/Target/JS/CodeGeneratorJS.icl
+7
-7
src/Sapl/Target/JS/Lifting.dcl
src/Sapl/Target/JS/Lifting.dcl
+1
-1
src/Sapl/Target/JS/Lifting.icl
src/Sapl/Target/JS/Lifting.icl
+4
-3
No files found.
src/Sapl/SaplParser.dcl
View file @
83c511af
definition
module
Sapl
.
SaplParser
import
Sapl
.
SaplTokenizer
,
Sapl
.
SaplStruct
import
Data
.
Void
,
Data
.
Error
import
Data
.
Error
from
Data
.
Map
import
::
Map
// Cannot be abstract because code generator uses it
::
ParserState
=
{
ps_level
::
Int
,
ps_constructors
::
Map
String
ConstructorDef
,
ps_functions
::
Map
String
[
SaplTypedVar
]
,
ps_CAFs
::
Map
String
Void
,
ps_CAFs
::
Map
String
()
,
ps_genFuns
::
[
FuncType
]
// generated functions during parsing
}
...
...
src/Sapl/SaplParser.icl
View file @
83c511af
implementation
module
Sapl
.
SaplParser
import
StdEnv
,
Data
.
Void
,
Data
.
Error
import
StdEnv
,
Data
.
Error
import
Sapl
.
SaplTokenizer
,
Sapl
.
SaplStruct
,
Sapl
.
FastString
from
Data
.
Map
import
::
Map
...
...
@@ -27,7 +27,7 @@ incLevel a :== \s -> Ok (a, {s & ps_level = s.ps_level + 1})
decLevel
a
:==
\
s
->
Ok
(
a
,
{
s
&
ps_level
=
s
.
ps_level
-
1
})
getLevel
:==
\
s
->
Ok
(
s
.
ps_level
,
s
)
addFunction
name
args
:==
\
s
->
Ok
(
name
,
{
s
&
ps_functions
=
'
DM
'.
put
(
unpackVar
name
)
args
s
.
ps_functions
})
addCAF
name
:==
\
s
->
Ok
(
name
,
{
s
&
ps_CAFs
=
'
DM
'.
put
(
unpackVar
name
)
Void
s
.
ps_CAFs
})
addCAF
name
:==
\
s
->
Ok
(
name
,
{
s
&
ps_CAFs
=
'
DM
'.
put
(
unpackVar
name
)
()
s
.
ps_CAFs
})
defaultState
=
{
ps_level
=
0
,
ps_constructors
=
'
DM
'.
newMap
,
ps_functions
=
'
DM
'.
newMap
,
ps_CAFs
=
'
DM
'.
newMap
,
ps_genFuns
=
[]}
addConstructor
name
def
:==
\
s
->
Ok
(
name
,
{
s
&
ps_constructors
=
'
DM
'.
put
(
unpackVar
name
)
def
s
.
ps_constructors
})
...
...
@@ -43,7 +43,7 @@ where
// Add Tuple constructor if necessary
addTupleCons
name
|
startsWith
"_Tuple"
name
&&
size
name
>
6
=
checkConstructor
name
>>=
\
b
=
if
b
(
returnS
Void
)
(
addConstructor
(
NormalVar
name
0
)
newdef
>>|
addGenFun
newadt
>>|
returnS
Void
)
>>=
\
b
=
if
b
(
returnS
())
(
addConstructor
(
NormalVar
name
0
)
newdef
>>|
addGenFun
newadt
>>|
returnS
()
)
where
(
newadt
,
newdef
)
=
gendefs
name
...
...
@@ -61,7 +61,7 @@ where
=
TypedVar
(
StrictVar
"_"
0
)
NoType
=
TypedVar
(
NormalVar
"_"
0
)
NoType
addTupleCons
_
=
returnS
Void
addTupleCons
_
=
returnS
()
read_int
[
TLit
(
LInt
lit
):
ts
]
=
returnS
(
Just
lit
,
ts
)
read_int
ts
=
returnS
(
Nothing
,
ts
)
...
...
src/Sapl/SaplStruct.icl
View file @
83c511af
implementation
module
Sapl
.
SaplStruct
import
StdEnv
import
Data
.
Map
,
Data
.
Void
,
Data
.
Error
import
Data
.
Error
,
Data
.
Maybe
import
Sapl
.
SaplTokenizer
ltVarByName
::
!
SaplVar
!
SaplVar
->
Bool
...
...
src/Sapl/Target/JS/CodeGeneratorJS.icl
View file @
83c511af
...
...
@@ -8,7 +8,7 @@ implementation module Sapl.Target.JS.CodeGeneratorJS
*
*/
import
StdEnv
,
Data
.
Maybe
,
Data
.
Void
,
Text
.
StringAppender
,
Sapl
.
FastString
import
StdEnv
,
Data
.
Maybe
,
Text
.
StringAppender
,
Sapl
.
FastString
import
qualified
Data
.
List
as
DL
import
qualified
Data
.
Map
as
DM
import
Text
.
Unicode
.
Encodings
.
JS
...
...
@@ -29,7 +29,7 @@ from Data.List import elem_by, partition
,
cs_current_vars
::
![
SaplTypedVar
]
,
cs_constructors
::
!
Map
String
ConstructorDef
,
cs_functions
::
!
Map
String
[
SaplTypedVar
]
,
cs_CAFs
::
!
Map
String
Void
,
cs_CAFs
::
!
Map
String
()
,
cs_builtins
::
!
Map
String
(
String
,
Int
)
,
cs_inlinefuncs
::
!
Map
String
InlineFunDef
,
cs_trampoline
::
!
Bool
...
...
@@ -114,7 +114,7 @@ isTailRecursive _ _ = False
strictnessMap
::
!
SaplType
!
CoderState
->
Int
strictnessMap
NoType
_
=
0
strictnessMap
(
Type
cons
)
{
cs_constructors
}
=
case
get
cons
cs_constructors
of
=
case
'
DM
'.
get
cons
cs_constructors
of
Nothing
=
0
(
Just
{
args
})
=
toInt
args
0
where
...
...
@@ -800,8 +800,8 @@ generateJS f tramp saplsrc mbPst
#
a
=
if
tramp
(
a
<++
"ON"
)
(
a
<++
"OFF"
)
// Lift + generated update functions
#
(
funcs
,
genfuns
)
=
foldl
(
upd
(
isStrictArgFlavour
f
newpst
))
([],
newMap
)
funcs
#
funcs
=
reverse
funcs
++
elems
genfuns
#
(
funcs
,
genfuns
)
=
foldl
(
upd
(
isStrictArgFlavour
f
newpst
))
([],
'
DM
'.
newMap
)
funcs
#
funcs
=
reverse
funcs
++
'
DM
'.
elems
genfuns
#
a
=
foldl
(\
a
curr
=
a
<++
funcCoder
curr
state
)
(
a
<++
"*/"
)
funcs
=
Ok
(
a
,
newpst
)
...
...
@@ -809,7 +809,7 @@ generateJS f tramp saplsrc mbPst
where
upd
::
(
String
Int
Int
->
Bool
)
([
FuncType
],
Map
String
FuncType
)
FuncType
->
([
FuncType
],
Map
String
FuncType
)
upd
sf
(
nfs
,
genfuns
)
fun
=
let
(
nfun
,
ngenfuns
)
=
prepareFun
sf
fun
genfuns
in
([
nfun
:
nfs
],
union
genfuns
ngenfuns
)
=
let
(
nfun
,
ngenfuns
)
=
prepareFun
sf
fun
genfuns
in
([
nfun
:
nfs
],
'
DM
'.
union
genfuns
ngenfuns
)
exprGenerateJS
::
!
Flavour
!
Bool
!
String
!(
Maybe
ParserState
)
!
StringAppender
->
(
MaybeErrorString
(
String
,
StringAppender
,
ParserState
))
exprGenerateJS
f
tramp
saplsrc
mbPst
out
...
...
@@ -819,7 +819,7 @@ exprGenerateJS f tramp saplsrc mbPst out
#
state
=
newState
f
tramp
newpst
// Lift + generated update functions. TODO: do not skip generated functions
#
(
body
,
_)
=
prepareExpr
(
isStrictArgFlavour
f
newpst
)
body
newMap
#
(
body
,
_)
=
prepareExpr
(
isStrictArgFlavour
f
newpst
)
body
'
DM
'.
newMap
#
a
=
termCoder
body
{
state
&
cs_inbody
=
Just
(
TypedVar
(
NormalVar
"__dummy"
0
)
NoType
)}
newAppender
#
out
=
foldl
(\
a
curr
=
a
<++
funcCoder
curr
state
)
out
s
.
ps_genFuns
...
...
src/Sapl/Target/JS/Lifting.dcl
View file @
83c511af
definition
module
Sapl
.
Target
.
JS
.
Lifting
import
Sapl
.
SaplStruct
import
Data
.
Map
from
Data
.
Map
import
::
Map
// Returns True if a term can be inlined, i.e. no separate statement is needed
inline
::
!
SaplTerm
->
Bool
...
...
src/Sapl/Target/JS/Lifting.icl
View file @
83c511af
...
...
@@ -2,7 +2,8 @@ implementation module Sapl.Target.JS.Lifting
import
StdEnv
import
Sapl
.
SaplStruct
import
Data
.
Map
from
Data
.
Map
import
::
Map
import
qualified
Data
.
Map
as
DM
inline
::
!
SaplTerm
->
Bool
inline
(
SLet
_
_)
=
False
...
...
@@ -90,10 +91,10 @@ where
#
(
expr
,
st
,
edefs
)
=
walkTerm
expr
doNotLift
False
st
#
(
updates
,
st
,
udefs
)
=
walkUpdates
updates
st
// Generate new fun and lift it in the same time
#
(
genfun
,
_)
=
prepareFun
sf
(
genUpdateFun
(
SUpdate
expr
ty
updates
))
newMap
#
(
genfun
,
_)
=
prepareFun
sf
(
genUpdateFun
(
SUpdate
expr
ty
updates
))
'
DM
'.
newMap
#
funname
=
extractName
genfun
=
(
SApplication
(
SVar
funname
)
[
expr
:
map
snd
updates
],
{
st
&
genfuns
=
put
(
unpackVar
funname
)
genfun
st
.
genfuns
},
edefs
++
udefs
)
{
st
&
genfuns
=
'
DM
'.
put
(
unpackVar
funname
)
genfun
st
.
genfuns
},
edefs
++
udefs
)
where
extractName
(
FTFunc
(
TypedVar
name
_)
_
_)
=
name
...
...
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