Verified Commit 1490da35 authored by Camil Staps's avatar Camil Staps 🚀

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
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 (toString v) of
jsGetCleanReference v w = case eval_js_with_return_value (js_val_to_string 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 (toString js) of
= case eval_js_with_return_value (js_val_to_string 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) (toString v) of
= case set_js (js_val_to_string sel) (js_val_to_string 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 (toString call) of
(.$) f args w = case eval_js_with_return_value (js_val_to_string 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 (toString call) of
(.$!) f args w = case eval_js (js_val_to_string 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 (toString new) of
jsNew cons args w = case eval_js_with_return_value (js_val_to_string 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 (toString (JSDelete v)) of
jsDelete v w = case eval_js (js_val_to_string (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 -> toString cb
Just cb -> js_val_to_string 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 (toString (JSCall (JSVar "console.log") {JSString (toString s)})) of
jsTrace s x = case eval_js (js_val_to_string (JSCall (JSVar "console.log") {JSString (toString s)})) of
True -> x
False -> abort_with_node s // just in case it is a JSVal