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
I
iTasks-SDK
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
73
Issues
73
List
Boards
Labels
Service Desk
Milestones
Merge Requests
6
Merge Requests
6
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
iTasks-SDK
Commits
1490da35
Verified
Commit
1490da35
authored
Jun 14, 2019
by
Camil Staps
🚀
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Optimize JS interface: try to discard the created string from the Clean heap after copying it to JS
parent
e460da63
Pipeline
#25365
failed with stage
in 1 minute and 24 seconds
Changes
2
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
271 additions
and
233 deletions
+271
-233
Libraries/iTasks/UI/JavaScript.icl
Libraries/iTasks/UI/JavaScript.icl
+240
-223
Libraries/iTasks/UI/WebPublic/js/abc-interpreter.js
Libraries/iTasks/UI/WebPublic/js/abc-interpreter.js
+31
-10
No files found.
Libraries/iTasks/UI/JavaScript.icl
View file @
1490da35
implementation
module
iTasks
.
UI
.
JavaScript
import
qualified
StdArray
import
StdEnv
import
StdGeneric
import
StdOverloadedList
import
Data
.
Func
import
Data
.
Maybe
import
Text
.
GenJSON
...
...
@@ -43,226 +45,241 @@ import Text.GenJSON
,
val
::
!
JSVal
}
instance
toString
JSVal
js_val_to_string
::
!
JSVal
->
.
String
js_val_to_string
v
#!
v
=
hyperstrict
v
#!
(
s
,
i
)
=
copy
v
('
StdArray
'.
_createArray
(
len
v
0
))
0
|
i
<
0
=
abort_with_node
v
=
s
where
toString
v
=
let
s
=
toS
v
in
if
(
size
s
<
0
)
(
abort_with_node
v
)
s
where
toS
::
!
JSVal
->
String
toS
v
=
fst
(
copy
v
(
createArray
(
len
v
0
)
'\0'
)
0
)
copy
::
!
JSVal
!*{#
Char
}
!
Int
->
(!.{#
Char
},
!
Int
)
copy
v
dest
i
=
case
v
of
JSInt
n
->
copy_chars
(
toString
n
)
dest
i
JSBool
True
#
dest
&
[
i
]=
't'
,[
i
+1
]=
'r'
,[
i
+2
]=
'u'
,[
i
+3
]=
'e'
->
(
dest
,
i
+4
)
JSBool
False
#
dest
&
[
i
]=
'f'
,[
i
+1
]=
'a'
,[
i
+2
]=
'l'
,[
i
+3
]=
's'
,[
i
+4
]=
'e'
->
(
dest
,
i
+5
)
JSString
s
#
dest
&
[
i
]
=
'\''
#
(
dest
,
i
)
=
copy_and_escape
s
0
dest
(
i
+1
)
#
dest
&
[
i
]
=
'\''
->
(
dest
,
i
+1
)
JSReal
r
->
copy_chars
(
toString
r
)
dest
i
JSVar
v
->
copy_chars
v
dest
i
JSNull
#
dest
&
[
i
]=
'n'
,[
i
+1
]=
'u'
,[
i
+2
]=
'l'
,[
i
+3
]=
'l'
->
(
dest
,
i
+4
)
JSUndefined
#
dest
&
[
i
]=
'u'
,[
i
+1
]=
'n'
,[
i
+2
]=
'd'
,[
i
+3
]=
'e'
,[
i
+4
]=
'f'
,[
i
+5
]=
'i'
,[
i
+6
]=
'n'
,[
i
+7
]=
'e'
,[
i
+8
]=
'd'
->
(
dest
,
i
+9
)
JSTypeOf
v
#
dest
&
[
i
]=
't'
,[
i
+1
]=
'y'
,[
i
+2
]=
'p'
,[
i
+3
]=
'e'
,[
i
+4
]=
'o'
,[
i
+5
]=
'f'
,[
i
+6
]=
' '
->
copy
v
dest
(
i
+7
)
JSDelete
v
#
dest
&
[
i
]=
'd'
,[
i
+1
]=
'e'
,[
i
+2
]=
'l'
,[
i
+3
]=
'e'
,[
i
+4
]=
't'
,[
i
+5
]=
'e'
,[
i
+6
]=
' '
->
copy
v
dest
(
i
+7
)
JSObject
elems
#
dest
&
[
i
]=
'{'
|
size
elems
==
0
#
dest
&
[
i
+1
]=
'}'
->
(
dest
,
i
+2
)
#
(
dest
,
i
)
=
copy_elems
elems
0
dest
(
i
+1
)
#
dest
&
[
i
]=
'}'
->
(
dest
,
i
+1
)
with
copy_elems
::
!{#
JSObjectElement
}
!
Int
!*{#
Char
}
!
Int
->
(!.{#
Char
},
!
Int
)
copy_elems
elems
k
dest
i
#
dest
&
[
i
]=
'"'
#
{
key
,
val
}
=
elems
.[
k
]
#
(
dest
,
i
)
=
copy_chars
key
dest
(
i
+1
)
#
dest
&
[
i
]=
'"'
#
dest
&
[
i
+1
]=
':'
#
(
dest
,
i
)
=
copy
val
dest
(
i
+2
)
|
k
+1
>=
size
elems
=
(
dest
,
i
)
=
copy_elems
elems
(
k
+1
)
{
dest
&
[
i
]=
','
}
(
i
+1
)
JSArray
elems
#
dest
&
[
i
]=
'['
|
size
elems
==
0
#
dest
&
[
i
+1
]=
']'
->
(
dest
,
i
+2
)
#
(
dest
,
i
)
=
copy_with_commas
elems
0
dest
(
i
+1
)
#
dest
&
[
i
]=
']'
->
(
dest
,
i
+1
)
JSCall
fun
args
#
(
dest
,
i
)
=
copy
fun
dest
i
#
dest
&
[
i
]=
'('
|
size
args
==
0
#
dest
&
[
i
+1
]=
')'
->
(
dest
,
i
+2
)
#
(
dest
,
i
)
=
copy_with_commas
args
0
dest
(
i
+1
)
#
dest
&
[
i
]=
')'
->
(
dest
,
i
+1
)
JSNew
cons
args
#
dest
&
[
i
]=
'n'
,[
i
+1
]=
'e'
,[
i
+2
]=
'w'
,[
i
+3
]=
' '
#
(
dest
,
i
)
=
copy_chars
cons
dest
(
i
+4
)
#
dest
&
[
i
]=
'('
|
size
args
==
0
#
dest
&
[
i
+1
]=
')'
->
(
dest
,
i
+2
)
#
(
dest
,
i
)
=
copy_with_commas
args
0
dest
(
i
+1
)
#
dest
&
[
i
]=
')'
->
(
dest
,
i
+1
)
JSSel
obj
attr
#
(
dest
,
i
)
=
copy
obj
dest
i
#
dest
&
[
i
]=
'['
#
(
dest
,
i
)
=
copy
attr
dest
(
i
+1
)
#
dest
&
[
i
]=
']'
->
(
dest
,
i
+1
)
JSSelPath
obj
path
#
(
dest
,
i
)
=
copy
obj
dest
i
#
dest
&
[
i
]=
'.'
->
copy_chars
path
dest
(
i
+1
)
JSRef
n
#
dest
&
[
i
]=
'A'
,[
i
+1
]=
'B'
,[
i
+2
]=
'C'
,[
i
+3
]=
'.'
,[
i
+4
]=
'j'
,[
i
+5
]=
's'
,[
i
+6
]=
'['
#
(
dest
,
i
)
=
copy_chars
(
toString
n
)
dest
(
i
+7
)
#
dest
&
[
i
]=
']'
->
(
dest
,
i
+1
)
JSCleanRef
n
#
dest
&
[
i
]=
'A'
,[
i
+1
]=
'B'
,[
i
+2
]=
'C'
,[
i
+3
]=
'.'
,[
i
+4
]=
'a'
,[
i
+5
]=
'p'
,[
i
+6
]=
'('
#
(
dest
,
i
)
=
copy_chars
(
toString
n
)
dest
(
i
+7
)
#
dest
&
[
i
]=
')'
->
(
dest
,
i
+1
)
where
copy_chars
::
!
String
!*{#
Char
}
!
Int
->
(!.{#
Char
},
!
Int
)
copy_chars
src
dest
i
=
(
copy`
src
(
sz
-1
)
dest
(
i
+
sz
-1
),
i
+
sz
)
where
sz
=
size
src
copy`
::
!
String
!
Int
!*{#
Char
}
!
Int
->
.{#
Char
}
copy`
_
-1
dest
_
=
dest
copy`
src
si
dest
di
=
copy`
src
(
si
-1
)
{
dest
&
[
di
]=
src
.[
si
]}
(
di
-1
)
copy_and_escape
::
!
String
!
Int
!*{#
Char
}
!
Int
->
(!.{#
Char
},
!
Int
)
copy_and_escape
src
si
dest
di
|
si
>=
size
src
=
(
dest
,
di
)
#
c
=
src
.[
si
]
|
c
<
'\x20'
#
c
=
toInt
c
#
dest
=
{
dest
&
[
di
]=
'\\'
,
[
di
+1
]=
'x'
,
[
di
+2
]=
hex
(
c
>>
4
),
[
di
+3
]=
hex
(
c
bitand
0x0f
)}
=
copy_and_escape
src
(
si
+1
)
dest
(
di
+4
)
|
c
==
'\''
||
c
==
'\\'
#
dest
=
{
dest
&
[
di
]=
'\\'
,
[
di
+1
]=
c
}
=
copy_and_escape
src
(
si
+1
)
dest
(
di
+2
)
|
otherwise
#
dest
=
{
dest
&
[
di
]=
c
}
=
copy_and_escape
src
(
si
+1
)
dest
(
di
+1
)
where
hex
i
=
"0123456789abcdef"
.[
i
]
copy_with_commas
::
!{!
JSVal
}
!
Int
!*{#
Char
}
!
Int
->
(!.{#
Char
},
!
Int
)
copy_with_commas
elems
k
dest
i
#
(
dest
,
i
)
=
copy
elems
.[
k
]
dest
i
|
k
+1
>=
size
elems
=
(
dest
,
i
)
=
copy_with_commas
elems
(
k
+1
)
{
dest
&
[
i
]=
','
}
(
i
+1
)
len
::
!
JSVal
!
Int
->
Int
len
v
l
=
case
v
of
JSInt
i
->
int_len
i
l
JSBool
b
->
if
b
4
5
+
l
JSString
s
->
escaped_size
s
(
size
s
-1
)
(
2
+
l
)
where
escaped_size
::
!
String
!
Int
!
Int
->
Int
escaped_size
s
-1
n
=
n
escaped_size
s
i
n
|
s
.[
i
]
<
'\x20'
=
escaped_size
s
(
i
-1
)
(
n
+4
)
|
s
.[
i
]
==
'\''
||
s
.[
i
]
==
'\\'
=
escaped_size
s
(
i
-1
)
(
n
+2
)
=
escaped_size
s
(
i
-1
)
(
n
+1
)
JSReal
r
->
size
(
toString
r
)
+
l
JSVar
v
->
size
v
+
l
JSNull
->
4
+
l
JSUndefined
->
9
+
l
JSTypeOf
v
->
len
v
(
7
+
l
)
JSDelete
v
->
len
v
(
7
+
l
)
JSObject
elems
copy
::
!
JSVal
!*{#
Char
}
!
Int
->
(!.{#
Char
},
!
Int
)
copy
v
dest
i
=
case
v
of
JSInt
n
->
copy_int
n
dest
i
JSBool
True
#
dest
&
[
i
]=
't'
,[
i
+1
]=
'r'
,[
i
+2
]=
'u'
,[
i
+3
]=
'e'
->
(
dest
,
i
+4
)
JSBool
False
#
dest
&
[
i
]=
'f'
,[
i
+1
]=
'a'
,[
i
+2
]=
'l'
,[
i
+3
]=
's'
,[
i
+4
]=
'e'
->
(
dest
,
i
+5
)
JSString
s
#
dest
&
[
i
]
=
'\''
#
(
dest
,
i
)
=
copy_and_escape
s
0
dest
(
i
+1
)
#
dest
&
[
i
]
=
'\''
->
(
dest
,
i
+1
)
JSReal
r
// TODO: this will trigger a warning in get_clean_string; try to write a copy_real à la copy_int
->
copy_chars
(
toString
r
)
dest
i
JSVar
v
->
copy_chars
v
dest
i
JSNull
#
dest
&
[
i
]=
'n'
,[
i
+1
]=
'u'
,[
i
+2
]=
'l'
,[
i
+3
]=
'l'
->
(
dest
,
i
+4
)
JSUndefined
#
dest
&
[
i
]=
'u'
,[
i
+1
]=
'n'
,[
i
+2
]=
'd'
,[
i
+3
]=
'e'
,[
i
+4
]=
'f'
,[
i
+5
]=
'i'
,[
i
+6
]=
'n'
,[
i
+7
]=
'e'
,[
i
+8
]=
'd'
->
(
dest
,
i
+9
)
JSTypeOf
v
#
dest
&
[
i
]=
't'
,[
i
+1
]=
'y'
,[
i
+2
]=
'p'
,[
i
+3
]=
'e'
,[
i
+4
]=
'o'
,[
i
+5
]=
'f'
,[
i
+6
]=
' '
->
copy
v
dest
(
i
+7
)
JSDelete
v
#
dest
&
[
i
]=
'd'
,[
i
+1
]=
'e'
,[
i
+2
]=
'l'
,[
i
+3
]=
'e'
,[
i
+4
]=
't'
,[
i
+5
]=
'e'
,[
i
+6
]=
' '
->
copy
v
dest
(
i
+7
)
JSObject
elems
#
dest
&
[
i
]=
'{'
|
size
elems
==
0
->
2
+
l
->
count_elems
(
size
elems
-1
)
(
l
+(
4
*
size
elems
)
+1
)
where
count_elems
::
!
Int
!
Int
->
Int
count_elems
-1
l
=
l
count_elems
i
l
#
{
key
,
val
}
=
elems
.[
i
]
=
count_elems
(
i
-1
)
(
len
val
(
l
+
size
key
))
JSArray
elems
#
dest
&
[
i
+1
]=
'}'
->
(
dest
,
i
+2
)
#
(
dest
,
i
)
=
copy_elems
elems
0
dest
(
i
+1
)
#
dest
&
[
i
]=
'}'
->
(
dest
,
i
+1
)
with
copy_elems
::
!{#
JSObjectElement
}
!
Int
!*{#
Char
}
!
Int
->
(!.{#
Char
},
!
Int
)
copy_elems
elems
k
dest
i
#
dest
&
[
i
]=
'"'
#
{
key
,
val
}
=
elems
.[
k
]
#
(
dest
,
i
)
=
copy_chars
key
dest
(
i
+1
)
#
dest
&
[
i
]=
'"'
#
dest
&
[
i
+1
]=
':'
#
(
dest
,
i
)
=
copy
val
dest
(
i
+2
)
|
k
+1
>=
size
elems
=
(
dest
,
i
)
=
copy_elems
elems
(
k
+1
)
{
dest
&
[
i
]=
','
}
(
i
+1
)
JSArray
elems
#
dest
&
[
i
]=
'['
|
size
elems
==
0
->
2
+
l
->
count_array
elems
(
size
elems
-1
)
(
size
elems
+1
+
l
)
JSCall
fun
args
#
dest
&
[
i
+1
]=
']'
->
(
dest
,
i
+2
)
#
(
dest
,
i
)
=
copy_with_commas
elems
0
dest
(
i
+1
)
#
dest
&
[
i
]=
']'
->
(
dest
,
i
+1
)
JSCall
fun
args
#
(
dest
,
i
)
=
copy
fun
dest
i
#
dest
&
[
i
]=
'('
|
size
args
==
0
->
len
fun
(
2
+
l
)
->
count_array
args
(
size
args
-1
)
(
len
fun
(
size
args
+1
+
l
))
JSNew
cons
args
#
dest
&
[
i
+1
]=
')'
->
(
dest
,
i
+2
)
#
(
dest
,
i
)
=
copy_with_commas
args
0
dest
(
i
+1
)
#
dest
&
[
i
]=
')'
->
(
dest
,
i
+1
)
JSNew
cons
args
#
dest
&
[
i
]=
'n'
,[
i
+1
]=
'e'
,[
i
+2
]=
'w'
,[
i
+3
]=
' '
#
(
dest
,
i
)
=
copy_chars
cons
dest
(
i
+4
)
#
dest
&
[
i
]=
'('
|
size
args
==
0
->
size
cons
+6
+
l
->
count_array
args
(
size
args
-1
)
(
size
cons
+5
+
size
args
+
l
)
JSSel
obj
attr
->
len
obj
(
len
attr
(
l
+2
))
JSSelPath
obj
path
->
len
obj
(
l
+1
+
size
path
)
JSRef
i
->
int_len
i
(
8
+
l
)
JSCleanRef
i
->
int_len
i
(
8
+
l
)
_
->
missing_case
v
#
dest
&
[
i
+1
]=
')'
->
(
dest
,
i
+2
)
#
(
dest
,
i
)
=
copy_with_commas
args
0
dest
(
i
+1
)
#
dest
&
[
i
]=
')'
->
(
dest
,
i
+1
)
JSSel
obj
attr
#
(
dest
,
i
)
=
copy
obj
dest
i
#
dest
&
[
i
]=
'['
#
(
dest
,
i
)
=
copy
attr
dest
(
i
+1
)
#
dest
&
[
i
]=
']'
->
(
dest
,
i
+1
)
JSSelPath
obj
path
#
(
dest
,
i
)
=
copy
obj
dest
i
#
dest
&
[
i
]=
'.'
->
copy_chars
path
dest
(
i
+1
)
JSRef
n
#
dest
&
[
i
]=
'A'
,[
i
+1
]=
'B'
,[
i
+2
]=
'C'
,[
i
+3
]=
'.'
,[
i
+4
]=
'j'
,[
i
+5
]=
's'
,[
i
+6
]=
'['
#
(
dest
,
i
)
=
copy_int
n
dest
(
i
+7
)
#
dest
&
[
i
]=
']'
->
(
dest
,
i
+1
)
JSCleanRef
n
#
dest
&
[
i
]=
'A'
,[
i
+1
]=
'B'
,[
i
+2
]=
'C'
,[
i
+3
]=
'.'
,[
i
+4
]=
'a'
,[
i
+5
]=
'p'
,[
i
+6
]=
'('
#
(
dest
,
i
)
=
copy_int
n
dest
(
i
+7
)
#
dest
&
[
i
]=
')'
->
(
dest
,
i
+1
)
where
copy_chars
::
!
String
!*{#
Char
}
!
Int
->
(!.{#
Char
},
!
Int
)
copy_chars
src
dest
i
#!
sz
=
size
src
=
(
copy`
src
(
sz
-1
)
dest
(
i
+
sz
-1
),
i
+
sz
)
where
int_len
::
!
Int
!
Int
->
Int
int_len
i
l
|
i
>
9
=
int_len
(
i
/
10
)
(
l
+1
)
|
i
<
0
=
int_len
(
0
-
i
)
(
l
+1
)
|
otherwise
=
l
+1
count_array
::
!{!
JSVal
}
!
Int
!
Int
->
Int
count_array
elems
-1
l
=
l
count_array
elems
i
l
=
count_array
elems
(
i
-1
)
(
len
elems
.[
i
]
l
)
missing_case
::
!
JSVal
->
.
a
missing_case
_
=
code {
print
"missing case in toString JSVal:
\n
"
.d
1
0
jsr
_print_graph
.o
0
0
halt
}
copy`
::
!
String
!
Int
!*{#
Char
}
!
Int
->
.{#
Char
}
copy`
_
-1
dest
_
=
dest
copy`
src
si
dest
di
=
copy`
src
(
si
-1
)
{
dest
&
[
di
]=
src
.[
si
]}
(
di
-1
)
copy_int
::
!
Int
!*{#
Char
}
!
Int
->
(!.{#
Char
},
!
Int
)
copy_int
n
dest
i
#!
dest
=
copy`
(
abs
n
)
dest
(
len
-1
)
#!
dest
=
if
(
n
<
0
)
{
dest
&
[
i
]=
'-'
}
dest
=
(
dest
,
i
+
len
)
where
len
=
int_len
n
0
copy`
::
!
Int
!*{#
Char
}
!
Int
->
.{#
Char
}
copy`
_
dest
-1
=
dest
copy`
n
dest
len
=
copy`
(
n
/
10
)
{
dest
&
[
i
+
len
]=
'0'
+
toChar
(
n
rem
10
)}
(
len
-1
)
copy_and_escape
::
!
String
!
Int
!*{#
Char
}
!
Int
->
(!.{#
Char
},
!
Int
)
copy_and_escape
src
si
dest
di
|
si
>=
size
src
=
(
dest
,
di
)
#
c
=
src
.[
si
]
|
c
<
'\x20'
#!
c
=
toInt
c
#
dest
=
{
dest
&
[
di
]=
'\\'
,
[
di
+1
]=
'x'
,
[
di
+2
]=
hex
(
c
>>
4
),
[
di
+3
]=
hex
(
c
bitand
0x0f
)}
=
copy_and_escape
src
(
si
+1
)
dest
(
di
+4
)
|
c
==
'\''
||
c
==
'\\'
#
dest
=
{
dest
&
[
di
]=
'\\'
,
[
di
+1
]=
c
}
=
copy_and_escape
src
(
si
+1
)
dest
(
di
+2
)
|
otherwise
#
dest
=
{
dest
&
[
di
]=
c
}
=
copy_and_escape
src
(
si
+1
)
dest
(
di
+1
)
where
hex
::
!
Int
->
Char
hex
i
=
"0123456789abcdef"
.[
i
]
copy_with_commas
::
!{!
JSVal
}
!
Int
!*{#
Char
}
!
Int
->
(!.{#
Char
},
!
Int
)
copy_with_commas
elems
k
dest
i
#
(
dest
,
i
)
=
copy
elems
.[
k
]
dest
i
|
k
+1
>=
size
elems
=
(
dest
,
i
)
=
copy_with_commas
elems
(
k
+1
)
{
dest
&
[
i
]=
','
}
(
i
+1
)
len
::
!
JSVal
!
Int
->
Int
len
v
l
=
case
v
of
JSInt
i
->
int_len
i
l
JSBool
b
->
if
b
4
5
+
l
JSString
s
->
escaped_size
s
(
size
s
-1
)
(
2
+
l
)
where
escaped_size
::
!
String
!
Int
!
Int
->
Int
escaped_size
s
-1
n
=
n
escaped_size
s
i
n
|
s
.[
i
]
<
'\x20'
=
escaped_size
s
(
i
-1
)
(
n
+4
)
|
s
.[
i
]
==
'\''
||
s
.[
i
]
==
'\\'
=
escaped_size
s
(
i
-1
)
(
n
+2
)
=
escaped_size
s
(
i
-1
)
(
n
+1
)
JSReal
r
->
size
(
toString
r
)
+
l
JSVar
v
->
size
v
+
l
JSNull
->
4
+
l
JSUndefined
->
9
+
l
JSTypeOf
v
->
len
v
(
7
+
l
)
JSDelete
v
->
len
v
(
7
+
l
)
JSObject
elems
|
size
elems
==
0
->
2
+
l
->
count_elems
(
size
elems
-1
)
(
l
+(
4
*
size
elems
)
+1
)
where
count_elems
::
!
Int
!
Int
->
Int
count_elems
-1
l
=
l
count_elems
i
l
#
{
key
,
val
}
=
elems
.[
i
]
=
count_elems
(
i
-1
)
(
len
val
(
l
+
size
key
))
JSArray
elems
|
size
elems
==
0
->
2
+
l
->
count_array
elems
(
size
elems
-1
)
(
size
elems
+1
+
l
)
JSCall
fun
args
|
size
args
==
0
->
len
fun
(
2
+
l
)
->
count_array
args
(
size
args
-1
)
(
len
fun
(
size
args
+1
+
l
))
JSNew
cons
args
|
size
args
==
0
->
size
cons
+6
+
l
->
count_array
args
(
size
args
-1
)
(
size
cons
+5
+
size
args
+
l
)
JSSel
obj
attr
->
len
obj
(
len
attr
(
l
+2
))
JSSelPath
obj
path
->
len
obj
(
l
+1
+
size
path
)
JSRef
i
->
int_len
i
(
8
+
l
)
JSCleanRef
i
->
int_len
i
(
8
+
l
)
_
->
missing_case
v
where
count_array
::
!{!
JSVal
}
!
Int
!
Int
->
Int
count_array
elems
-1
l
=
l
count_array
elems
i
l
=
count_array
elems
(
i
-1
)
(
len
elems
.[
i
]
l
)
int_len
::
!
Int
!
Int
->
Int
int_len
i
l
|
i
>
9
=
int_len
(
i
/
10
)
(
l
+1
)
|
i
<
0
=
int_len
(
0
-
i
)
(
l
+1
)
|
otherwise
=
l
+1
missing_case
::
!
JSVal
->
.
a
missing_case
_
=
code {
print
"missing case in js_val_to_string:
\n
"
.d
1
0
jsr
_print_graph
.o
0
0
halt
}
jsMakeCleanReference
::
a
!
JSVal
!*
JSWorld
->
*(!
JSVal
,
!*
JSWorld
)
jsMakeCleanReference
x
attach_to
w
=
(
share
attach_to
x
,
w
)
jsGetCleanReference
::
!
JSVal
!*
JSWorld
->
*(!
Maybe
b
,
!*
JSWorld
)
jsGetCleanReference
v
w
=
case
eval_js_with_return_value
(
toS
tring
v
)
of
jsGetCleanReference
v
w
=
case
eval_js_with_return_value
(
js_val_to_s
tring
v
)
of
JSCleanRef
i
->
case
fetch
i
of
(
val
,
True
)
->
(
Just
val
,
w
)
_
->
if
(
1
==
1
)
(
Nothing
,
w
)
(
abort_with_node
v
)
...
...
@@ -276,10 +293,10 @@ where
}
jsFreeCleanReference
::
!
JSVal
!*
JSWorld
->
*
JSWorld
jsFreeCleanReference
(
JSCleanRef
ref
)
w
=
case
eval_js
clear
of
jsFreeCleanReference
(
JSCleanRef
ref
)
w
=
case
eval_js
(
js_val_to_string
clear
)
of
True
->
w
where
clear
=
"ABC.clear_shared_clean_value("
+++
toString
ref
+++
",true)"
clear
=
JSCall
(
JSVar
"ABC.clear_shared_clean_value"
)
{
JSInt
ref
,
JSBool
True
}
jsTypeOf
::
!
JSVal
->
JSVal
jsTypeOf
v
=
JSTypeOf
v
...
...
@@ -417,7 +434,7 @@ where
#
(
done
,
js
)
=
try_local_computation
js
|
done
=
(
js
,
w
)
=
case
eval_js_with_return_value
(
toS
tring
js
)
of
=
case
eval_js_with_return_value
(
js_val_to_s
tring
js
)
of
JSUnused
->
abort_with_node
js
result
->
(
result
,
w
)
where
...
...
@@ -447,7 +464,7 @@ where
(.=)
infixl
1
::
!
JSVal
!
b
!*
JSWorld
->
*
JSWorld
|
gToJS
{|*|}
b
(.=)
sel
v
w
#
v
=
toJS
v
=
case
set_js
(
toString
sel
)
(
toS
tring
v
)
of
=
case
set_js
(
js_val_to_string
sel
)
(
js_val_to_s
tring
v
)
of
True
->
w
False
->
abort_with_node
(
sel
,
v
)
...
...
@@ -478,28 +495,28 @@ instance toJSArgs (a,b,c,d,e,f) | gToJS{|*|} a & gToJS{|*|} b & gToJS{|*|} c & g
where
toJSArgs
(
a
,
b
,
c
,
d
,
e
,
f
)
=
{
toJS
a
,
toJS
b
,
toJS
c
,
toJS
d
,
toJS
e
,
toJS
f
}
(.$)
infixl
2
::
!
JSFun
!
b
!*
JSWorld
->
*(!
JSVal
,
!*
JSWorld
)
|
toJSArgs
b
(.$)
f
args
w
=
case
eval_js_with_return_value
(
toS
tring
call
)
of
(.$)
f
args
w
=
case
eval_js_with_return_value
(
js_val_to_s
tring
call
)
of
JSUnused
->
abort_with_node
call
result
->
(
result
,
w
)
where
call
=
JSCall
f
(
toJSArgs
args
)
(.$!)
infixl
2
::
!
JSFun
!
b
!*
JSWorld
->
*
JSWorld
|
toJSArgs
b
(.$!)
f
args
w
=
case
eval_js
(
toS
tring
call
)
of
(.$!)
f
args
w
=
case
eval_js
(
js_val_to_s
tring
call
)
of
True
->
w
False
->
abort_with_node
call
where
call
=
JSCall
f
(
toJSArgs
args
)
jsNew
::
!
String
!
a
!*
JSWorld
->
*(!
JSVal
,
!*
JSWorld
)
|
toJSArgs
a
jsNew
cons
args
w
=
case
eval_js_with_return_value
(
toS
tring
new
)
of
jsNew
cons
args
w
=
case
eval_js_with_return_value
(
js_val_to_s
tring
new
)
of
JSUnused
->
abort_with_node
new
result
->
(
result
,
w
)
where
new
=
JSNew
cons
(
toJSArgs
args
)
jsDelete
::
!
JSVal
!*
JSWorld
->
*
JSWorld
jsDelete
v
w
=
case
eval_js
(
toS
tring
(
JSDelete
v
))
of
jsDelete
v
w
=
case
eval_js
(
js_val_to_s
tring
(
JSDelete
v
))
of
True
->
w
False
->
abort_with_node
v
...
...
@@ -577,10 +594,10 @@ addJSFromUrl js mbCallback w = case add_js js callback of
False
->
abort_with_node
mbCallback
where
callback
=
case
mbCallback
of
Just
cb
->
toS
tring
cb
Just
cb
->
js_val_to_s
tring
cb
Nothing
->
""
add_js
::
!
String
!
String
->
Bool
add_js
::
!
String
!
*
String
->
Bool
add_js
_
_
=
code {
instruction
11
pop_a
2
...
...
@@ -588,25 +605,25 @@ where
}
jsTrace
::
!
a
.
b
->
.
b
|
toString
a
jsTrace
s
x
=
case
eval_js
(
toS
tring
(
JSCall
(
JSVar
"console.log"
)
{
JSString
(
toString
s
)}))
of
jsTrace
s
x
=
case
eval_js
(
js_val_to_s
tring
(
JSCall
(
JSVar
"console.log"
)
{
JSString
(
toString
s
)}))
of
True
->
x
False
->
abort_with_node
s
// just in case it is a JSVal
set_js
::
!
String
!
String
->
Bool
set_js
::
!
*
String
!*
String
->
Bool
set_js
var
val
=
code {
instruction
1
pop_a
2
pushB
TRUE
}
eval_js
::
!
String
->
Bool
eval_js
::
!
*
String
->
Bool
eval_js
s
=
code {
instruction
2
pop_a
1
pushB
TRUE
}
eval_js_with_return_value
::
!
String
->
JSVal
eval_js_with_return_value
::
!
*
String
->
JSVal
eval_js_with_return_value
s
=
code {
instruction
3
fill_a
0
1
...
...
Libraries/iTasks/UI/WebPublic/js/abc-interpreter.js
View file @
1490da35