implementation module ABC.Interpreter.JavaScript

import qualified StdArray
import StdEnv
import StdGeneric
import StdOverloadedList

import Data.Func
import qualified Data.Map
from Data.Map import :: Map
import Data.Maybe
import Text.Encodings.Base64
import Text.GenJSON

import ABC.Interpreter

:: JSWorld = JSWorld

:: JSVal
	= JSInt !Int
	| JSBool !Bool
	| JSString !String
	| JSReal !Real

	| JSVar !String
	| JSNull
	| JSUndefined
	| JSTypeOf !JSVal
	| JSInstanceOf !JSVal !JSVal
	| JSDelete !JSVal // actually a statement, not an expression

	| JSObject !{#JSObjectElement}
	| JSArray !{!JSVal}

	| JSCall !JSVal !{!JSVal}
	| JSNew !JSVal !{!JSVal}

	| JSSel !JSVal !JSVal // x[y]
	| JSSelPath !JSVal !String // x.path1.path2...pathn

	| JSRef !Int // a reference to js
		// NB: JSRef is handled specially in the garbage collector in
		// abc-interpreter-util.wat because the JavaScript world needs to know
		// which references are still present. If the type here changes, that
		// code must be updated too.
	| JSCleanRef !Int // a reference to shared_clean_values

	| JSTempPair !JSVal !JSVal
	| JSTempField !String !JSVal

	| JSUnused // used as always-False pattern match; see comments on abort_with_node.

:: JSObjectElement =
	{ key :: !String
	, val :: !JSVal
	}

instance toString JSVal where toString v = js_val_to_string v

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
	copy :: !JSVal !*{#Char} !Int -> (!.{#Char}, !Int)
	copy (JSInt n) dest i
		= copy_int n dest i
	copy (JSBool True) dest i
		# dest & [i]='t',[i+1]='r',[i+2]='u',[i+3]='e'
		= (dest,i+4)
	copy (JSBool False) dest i
		# dest & [i]='f',[i+1]='a',[i+2]='l',[i+3]='s',[i+4]='e'
		= (dest,i+5)
	copy (JSString s) dest i
		# dest & [i] = '\''
		# (dest,i) = copy_and_escape s 0 dest (i+1)
		# dest & [i] = '\''
		= (dest,i+1)
	copy (JSReal r) dest i
		// NB: this will trigger a warning in get_clean_string because the
		// created String cannot be removed from the heap. Better would be to
		// write a copy_real à la copy_int, but this is non-trivial. Another
		// option is to walk the JSVal in JavaScript instead of creating a
		// string.
		= copy_chars (toString r) dest i

	copy (JSVar v) dest i
		= copy_chars v dest i
	copy JSNull dest i
		# dest & [i]='n',[i+1]='u',[i+2]='l',[i+3]='l'
		= (dest,i+4)
	copy JSUndefined dest i
		# 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)
	copy (JSTypeOf v) dest i
		# 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)
	copy (JSInstanceOf val cls) dest i
		# (dest,i) = copy val dest i
		# dest & [i]  =' ',[i+1]='i',[i+2]='n',[i+3]='s',[i+ 4]='t',[i+ 5]='a'
		       , [i+6]='n',[i+7]='c',[i+8]='e',[i+9]='o',[i+10]='f',[i+11]=' '
		= copy cls dest (i+12)
	copy (JSDelete v) dest i
		# 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)

	copy (JSObject elems) dest i
		# 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)
	where
		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)

	copy (JSArray elems) dest i
		# 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)

	copy (JSCall fun args) dest i
		# (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)
	copy (JSNew cons args) dest i
		# dest & [i]='n',[i+1]='e',[i+2]='w',[i+3]=' '
		# (dest,i) = copy 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)

	copy (JSSel obj attr) dest i
		# (dest,i) = copy obj dest i
		# dest & [i]='['
		# (dest,i) = copy attr dest (i+1)
		# dest & [i]=']'
		= (dest,i+1)
	copy (JSSelPath obj path) dest i
		# (dest,i) = copy obj dest i
		# dest & [i]='.'
		= copy_chars path dest (i+1)

	copy (JSRef n) dest i
		# 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)
	copy (JSCleanRef n) dest i
		# 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)

	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
		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 (JSInt i) l = int_len i l
	len (JSBool b) l = if b 4 5 + l
	len (JSString s) l = 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)
	len (JSReal r) l = size (toString r) + l

	len (JSVar v) l = size v + l
	len JSNull l = 4+l
	len JSUndefined l = 9+l
	len (JSTypeOf v) l = len v (7+l)
	len (JSInstanceOf v cls) l = len cls (12+len v l)
	len (JSDelete v) l = len v (7+l)

	len (JSObject elems) l
		| 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))

	len (JSArray elems) l
		| size elems==0
			= 2+l
			= count_array elems (size elems-1) (size elems+1+l)

	len (JSCall fun args) l
		| size args==0
			= len fun (2+l)
			= count_array args (size args-1) (len fun (size args+1+l))
	len (JSNew cons args) l
		| size args==0
			= len cons (6+l)
			= count_array args (size args-1) (len cons (5+size args+l))

	len (JSSel obj attr) l = len obj (len attr (l+2))
	len (JSSelPath obj path) l = len obj (l+1+size path)

	len (JSRef i) l = int_len i (8+l)
	len (JSCleanRef i) l = int_len i (8+l)

	len v l = missing_case v
	where
		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
		}

	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

jsMakeCleanReference :: !a !JSVal !*JSWorld -> *(!JSVal, !*JSWorld)
jsMakeCleanReference x attach_to w = (share attach_to x, w)

jsGetCleanReference :: !JSVal !*JSWorld -> *(! ?b, !*JSWorld)
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) (?None, w) (abort_with_node v)
where
	fetch :: !Int -> (!a, !Bool)
	fetch _ = code {
		create
		instruction 5
		pop_b 1
		pushB TRUE
	}

jsFreeCleanReference :: !JSVal !*JSWorld -> *JSWorld
jsFreeCleanReference (JSCleanRef ref) w
	| eval_js (js_val_to_string clear)
		= w
where
	clear = JSCall (JSVar "ABC.clear_shared_clean_value") {JSInt ref}

jsTypeOf :: !JSVal -> JSVal
jsTypeOf v = JSTypeOf v

instance jsInstanceOf String where (jsInstanceOf) arg cls = arg jsInstanceOf (jsGlobal cls)
instance jsInstanceOf JSVal where (jsInstanceOf) arg cls = JSInstanceOf (toJS arg) cls

jsIsUndefined :: !JSVal -> Bool
jsIsUndefined v = v=:JSUndefined

jsIsNull :: !JSVal -> Bool
jsIsNull v = v=:JSNull

instance fromJS Int    where jsValToMaybe v = jsValToInt    v
instance fromJS Bool   where jsValToMaybe v = jsValToBool   v
instance fromJS String where jsValToMaybe v = jsValToString v
instance fromJS Real   where jsValToMaybe v = jsValToReal   v

jsValToInt :: !JSVal -> ?Int
jsValToInt (JSInt i)    = ?Just i
jsValToInt (JSReal r)   = ?Just (toInt r)
jsValToInt (JSString s) = let i = toInt s in if (i == 0 && s <> "0") ?None (?Just i)
jsValToInt _ = ?None

jsValToBool :: !JSVal -> ?Bool
jsValToBool (JSBool b)         = ?Just b
jsValToBool (JSInt i)          = ?Just (i<>0)
jsValToBool (JSReal r)         = ?Just (r<>0.0)
jsValToBool (JSString "true")  = ?Just True
jsValToBool (JSString "false") = ?Just False
jsValToBool _                  = ?None

jsValToString :: !JSVal -> ?String
jsValToString (JSString s) = ?Just s
jsValToString (JSInt i)    = ?Just (toString i)
jsValToString (JSReal r)   = ?Just (toString r)
jsValToString (JSBool b)   = ?Just (if b "true" "false")
jsValToString _            = ?None

jsValToReal :: !JSVal -> ?Real
jsValToReal (JSReal r)   = ?Just r
jsValToReal (JSInt i)    = ?Just (toReal i)
jsValToReal (JSString s) = ?Just (toReal s)
jsValToReal _            = ?None

jsValToList :: !JSVal !(JSVal -> ?a) !*JSWorld -> *(! ?[a], !*JSWorld)
jsValToList (JSArray arr) get w = (get_elements arr [] (size arr-1), w)
where
	get_elements arr xs -1 = ?Just xs
	get_elements arr xs i = case get arr.[i] of
		?None   -> ?None
		?Just x -> get_elements arr [x:xs] (i-1)
jsValToList arr get w
# (len,w) = arr .# "length" .? w // get length before array is evaluated
# (arr,w) = arr .? w // copy array to Clean
= case jsValToInt len of
	?None     -> (?None,w)
	?Just len -> get_elements arr [] (len-1) w
where
	get_elements arr xs -1 w = (?Just xs,w)
	get_elements arr xs i w
	# (x,w) = arr .# i .? w
	= case get x of
		?None   -> (?None,w)
		?Just x -> get_elements arr [x:xs] (i-1) w

jsValToList` :: !JSVal !(JSVal -> a) !*JSWorld -> *(![a], !*JSWorld)
jsValToList` (JSArray arr) get w = ([get x \\ x <-: arr], w)
jsValToList` arr get w
# (len,w) = arr .# "length" .? w // get length before array is evaluated
# (arr,w) = arr .? w // copy array to Clean
= get_elements arr [] (fromJS 0 len - 1) w
where
	get_elements arr xs -1 w = (xs,w)
	get_elements arr xs i w
	# (x,w) = arr .# i .? w
	= get_elements arr [get x:xs] (i-1) w

gToJS{|Int|} i = JSInt i
gToJS{|Bool|} b = JSBool b
gToJS{|String|} s = JSString s
gToJS{|Real|} r = JSReal r
gToJS{|JSVal|} v = v
gToJS{| ? |} fx ?None = JSNull
gToJS{| ? |} fx (?Just x) = fx x
gToJS{|[]|} fx xs = JSArray {fx x \\ x <- xs}
gToJS{|(,)|} fa fb (a,b) = JSArray {fa a,fb b}
gToJS{|(,,)|} fa fb fc (a,b,c) = JSArray {fa a,fb b,fc c}
gToJS{|(,,,)|} fa fb fc fd (a,b,c,d) = JSArray {fa a,fb b,fc c,fd d}
gToJS{|(,,,,)|} fa fb fc fd fe (a,b,c,d,e) = JSArray {fa a,fb b,fc c,fd d,fe e}

gToJS{|JSONNode|} JSONNull        = JSNull
gToJS{|JSONNode|} (JSONBool b)    = JSBool b
gToJS{|JSONNode|} (JSONInt i)     = JSInt i
gToJS{|JSONNode|} (JSONReal r)    = JSReal r
gToJS{|JSONNode|} (JSONString s)  = JSString s
gToJS{|JSONNode|} (JSONArray xs)  = JSArray {toJS x \\ x <- xs}
gToJS{|JSONNode|} (JSONObject xs) = JSObject {{key=k,val=toJS v} \\ (k,v) <- xs}
gToJS{|JSONNode|} _               = abort "ABC.Interpreter.JavaScript: missing case in gToJS{|JSONNode|}\n"

gToJS{|PAIR|} fx fy (PAIR x y) = JSTempPair (fx x) (fy y)
gToJS{|FIELD of {gfd_name}|} fx (FIELD x) = JSTempField gfd_name (fx x)
gToJS{|RECORD|} fx (RECORD x) = JSObject {e \\ e <|- collect_elems (fx x)}
where
	collect_elems :: !JSVal -> [!JSObjectElement!]
	collect_elems (JSTempField k v) = [!{key=k,val=v}!]
	collect_elems (JSTempPair a b)  = collect_elems a ++| collect_elems b

gToJS{|JSRecord|} (JSRecord vs) = JSObject {{key=k,val=v} \\ (k,v) <- list}
where
	list = 'Data.Map'.toList vs

(:>) infix 1 :: !String !a -> (String, JSVal) | gToJS{|*|} a
(:>) key val = (key, toJS val)

jsRecord :: ![(String, JSVal)] -> JSRecord
jsRecord vs = JSRecord ('Data.Map'.fromList vs)

instance .# Int
where
	(.#) (JSArray xs) i
		| 0<=i && i<size xs
			= xs.[i]
			= JSUndefined
	(.#) arr i = JSSel arr (JSInt i)

instance .# String
where
	(.#) obj path
		| contains_dot (size path-1) path
			= JSSelPath obj path
			= JSSel obj (JSString path)
	where
		contains_dot -1 _ = False
		contains_dot i s = if (s.[i]=='.') True (contains_dot (i-1) s)

(.#!) infixl 3 :: !JSVal !String -> JSVal
(.#!) obj key = JSSel obj (JSString key)

(.?) infixl 1 :: !JSVal !*JSWorld -> *(!JSVal, !*JSWorld)
(.?) js w
# (done,js) = try_local_computation js
= if done (js,w) (jsForceFetch js w)
where
	try_local_computation :: !JSVal -> (!Bool, !JSVal)
	try_local_computation v=:(JSInt _)      = (True,v)
	try_local_computation v=:(JSBool _)     = (True,v)
	try_local_computation v=:(JSString _)   = (True,v)
	try_local_computation v=:(JSReal _)     = (True,v)

	try_local_computation v=:JSNull         = (True,v)
	try_local_computation v=:JSUndefined    = (True,v)

	try_local_computation (JSSel (JSArray xs) (JSInt i))
		| 0<=i && i<size xs
			= try_local_computation xs.[i]
			= (True,JSUndefined)
	try_local_computation (JSSel (JSArray xs) (JSString "length"))
		= (True,JSInt (size xs))
	try_local_computation (JSSelPath (JSArray xs) "length")
		= (True,JSInt (size xs))

	try_local_computation v=:(JSRef _)      = (True,v)
	try_local_computation v=:(JSCleanRef _) = (True,v)

	try_local_computation v                 = (False,v)

(.??) infixl 1 :: !JSVal !*(!a, !*JSWorld) -> *(!a, !*JSWorld) | fromJS a
(.??) v (default,w)
	# (v,w) = v .? w
	= (fromJS default v, w)

jsForceFetch :: !JSVal !*JSWorld -> *(!JSVal, !*JSWorld)
jsForceFetch js w = case eval_js_with_return_value (js_val_to_string js) of
	JSUnused -> abort_with_node js
	result   -> (result, w)

(.=) infixl 1 :: !JSVal !b !*JSWorld -> *JSWorld | gToJS{|*|} b
(.=) sel v w
	# v = toJS v
	| set_js (js_val_to_string sel) (js_val_to_string v)
		= w
		= abort_with_node (sel,v)

instance toJSArgs () where toJSArgs _ = {}
instance toJSArgs Int where toJSArgs i = {toJS i}
instance toJSArgs Real where toJSArgs r = {toJS r}
instance toJSArgs Bool where toJSArgs b = {toJS b}
instance toJSArgs String where toJSArgs s = {toJS s}

instance toJSArgs JSVal where toJSArgs v = {v}
instance toJSArgs JSRecord where toJSArgs r = {toJS r}
instance toJSArgs JSONNode where toJSArgs j = {toJS j}

instance toJSArgs [a] | gToJS{|*|} a
where
	toJSArgs v = {JSArray {toJS x \\ x <- v}}

instance toJSArgs (?a) | gToJS{|*|} a
where
	toJSArgs v = case v of
		?Just v -> {toJS v}
		?None   -> {JSNull}

instance toJSArgs (a,b) | gToJS{|*|} a & gToJS{|*|} b
where
	toJSArgs :: !(!a,!b) -> {!JSVal} | gToJS{|*|} a & gToJS{|*|} b
	toJSArgs (a,b) = {toJS a, toJS b}

instance toJSArgs (a,b,c) | gToJS{|*|} a & gToJS{|*|} b & gToJS{|*|} c
where
	toJSArgs :: !(!a,!b,!c) -> {!JSVal} | gToJS{|*|} a & gToJS{|*|} b & gToJS{|*|} c
	toJSArgs (a,b,c) = {toJS a, toJS b, toJS c}

instance toJSArgs (a,b,c,d) | gToJS{|*|} a & gToJS{|*|} b & gToJS{|*|} c & gToJS{|*|} d
where
	toJSArgs :: !(!a,!b,!c,!d) -> {!JSVal} | gToJS{|*|} a & gToJS{|*|} b & gToJS{|*|} c & gToJS{|*|} d
	toJSArgs (a,b,c,d) = {toJS a, toJS b, toJS c, toJS d}

instance toJSArgs (a,b,c,d,e) | gToJS{|*|} a & gToJS{|*|} b & gToJS{|*|} c & gToJS{|*|} d & gToJS{|*|} e
where
	toJSArgs :: !(!a,!b,!c,!d,!e) -> {!JSVal} | gToJS{|*|} a & gToJS{|*|} b & gToJS{|*|} c & gToJS{|*|} d & gToJS{|*|} e
	toJSArgs (a,b,c,d,e) = {toJS a, toJS b, toJS c, toJS d, toJS e}

instance toJSArgs (a,b,c,d,e,f) | gToJS{|*|} a & gToJS{|*|} b & gToJS{|*|} c & gToJS{|*|} d & gToJS{|*|} e & gToJS{|*|} f
where
	toJSArgs :: !(!a,!b,!c,!d,!e,!f) -> {!JSVal} | gToJS{|*|} a & gToJS{|*|} b & gToJS{|*|} c & gToJS{|*|} d & gToJS{|*|} e & gToJS{|*|} f
	toJSArgs (a,b,c,d,e,f) = {toJS a, toJS b, toJS c, toJS d, toJS e, toJS f}

jsCall :: !JSFun !a -> JSVal | toJSArgs a
jsCall f args = JSCall f (toJSArgs args)

(.$) infixl 2 :: !JSFun !a !*JSWorld -> *(!JSVal, !*JSWorld) | toJSArgs a
(.$) 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 !a !*(!r, !*JSWorld) -> *(!r, !*JSWorld) | toJSArgs a & fromJS r
(.$?) f args (default,w)
	# (r,w) = (f .$ args) w
	= (fromJS default r, w)

(.$!) infixl 2 :: !JSFun !a !*JSWorld -> *JSWorld | toJSArgs a
(.$!) f args w
	| eval_js (js_val_to_string call)
		= w
		= abort_with_node call
where
	call = JSCall f (toJSArgs args)

instance jsNew String where jsNew cons args w = jsNew (JSVar cons) args w

instance jsNew JSVal
where
	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
	| eval_js (js_val_to_string (JSDelete v))
		= w
		= abort_with_node v

jsEmptyObject :: !*JSWorld -> *(!JSVal, !*JSWorld)
jsEmptyObject w = (eval_js_with_return_value "{}", w)

jsGlobal :: !String -> JSVal
jsGlobal s = JSVar s

jsWrapFun :: !({!JSVal} *JSWorld -> *JSWorld) !JSVal !*JSWorld -> *(!JSFun, !*JSWorld)
jsWrapFun f attach_to world = (share attach_to \(JSArray args) w -> f args w, world)

jsWrapFunWithResult :: !({!JSVal} *JSWorld -> *(JSVal, *JSWorld)) !JSVal !*JSWorld -> *(!JSFun, !*JSWorld)
jsWrapFunWithResult f attach_to world = (share attach_to fun, world)
where
	fun (JSArray args) w
	# (r,w) = f args w
	= hyperstrict (js_val_to_string r,w)

wrapInitFunction :: !(JSVal *JSWorld -> *JSWorld) -> {!JSVal} -> *JSWorld -> *JSWorld
wrapInitFunction f = init
where
	init :: !{!JSVal} !*JSWorld -> *JSWorld
	init args w
	# (needs_init,ok) = get_arg args.[1]
	| not ok = abort "internal error in wrapInitFunction\n"
	| needs_init==1 && init (IF_INT_64_OR_32 False True) val = abort "internal error in wrapInitFunction\n"
	# (ref,ok) = get_arg args.[0]
	| not ok = abort "internal error in wrapInitFunction\n"
	= f (JSRef ref) w
	where
		// This function ensures that the client knows the addresses of some
		// of the constructors which it needs to know.
		init :: !Bool !{!JSVal} -> Bool
		init _ _ = code {
			instruction 9
			pop_a 1
			pop_b 1
			pushB FALSE
		}

		val :: {!JSVal}
		val =
			{ JSInt 0
			, JSBool True
			, JSString ""
			, JSReal 0.0
			, JSNull
			, JSUndefined
			, JSArray {}
			, JSRef 0
			, JSCleanRef 0
			}

		get_arg :: !a -> (!Int,!Bool)
		get_arg _ = code {
			pushB TRUE
			repl_r_args 0 1
		}

jsSerializeGraph :: a !PrelinkedInterpretationEnvironment -> String
jsSerializeGraph graph env
	# serialized = serialize_for_prelinked_interpretation graph env
	= base64Encode serialized

jsDeserializeGraph :: !*String !*JSWorld -> *(!.a, !*JSWorld)
jsDeserializeGraph s w = (deserialize (base64Decode s), w)
where
	deserialize :: !*String -> .a
	deserialize _ = code {
		instruction 6
	}

jsDeserializeJSVal :: !JSVal !*JSWorld -> *(!.a, !*JSWorld)
jsDeserializeJSVal v w
	# (val,ok) = deserialize (js_val_to_string v)
	| ok
		= (val, w)
		= abort_with_node v
where
	deserialize :: !*String -> (!.a, !Bool)
	deserialize _ = code {
		instruction 7
		pushB TRUE
	}

jsSerializeOnClient :: .a !*JSWorld -> (!JSVal, !*JSWorld)
jsSerializeOnClient graph w = (serialize graph, w)
where
	serialize :: .a -> JSVal
	serialize _ = code {
		instruction 8
	}

jsDeserializeFromClient :: !String !PrelinkedInterpretationEnvironment -> (.a, !Int)
jsDeserializeFromClient s pie = deserialize_from_prelinked_interpreter (base64Decode s) pie

addCSSFromUrl :: !String !(?JSFun) !*JSWorld -> *JSWorld
addCSSFromUrl css mbCallback w
	| add_css css (maybe "" js_val_to_string mbCallback)
		= w
		= abort_with_node mbCallback
where
	add_css :: !String !*String -> Bool
	add_css _ _ = code {
		instruction 11
		pop_a 2
		pushB TRUE
	}

/**
 * A map with for each file:
 *   - `True` if the file is loaded already
 *   - an array of callback if the file is currently loading, which are called afterwards
 *   - no entry otherwise
 */
jsFileStates :: JSVal
jsFileStates =: jsGlobal "ABC.jsFileStates"

addJSFromUrl :: !String !(?JSFun) !JSVal !*JSWorld -> *JSWorld
addJSFromUrl js mbCallback val w
	# (fileState, w) = jsFileStates .# "get" .$ js $ w
	| (jsValToBool fileState) =: (?Just True) = maybeSt w (\cb -> cb .$! ())  mbCallback
	# (alreadyLoading, (callbacks, w)) =
		if (jsIsUndefined fileState) (False, jsNew "Array" () w) (True, (fileState, w))
	// add callback to array
	# w =
		maybeSt
			w
			(\cb world
				# (cbs, world`) = callbacks .# "concat" .$ [cb] $ world
				-> jsFileStates .# "set" .$! (js, cbs) $ world`
			)
			mbCallback
	| alreadyLoading = w
	# (cb, w) = jsWrapFun afterLoad val w
	| add_js js $ js_val_to_string cb
		= w
		= abort_with_node cb
where
	afterLoad :: {!JSVal} !*JSWorld -> *JSWorld
	afterLoad _ world
		# (callbacks, world) = jsFileStates .# "get" .$ js $ world
		# (?Just callbacks, world) = jsValToList callbacks ?Just world
		# world = jsFileStates .# "set" .$! (js, True) $ world
		= foldl (\world cb -> cb .$! () $ world) world callbacks

	add_js :: !String !*String -> Bool
	add_js _ _ = code {
		instruction 12
		pop_a 2
		pushB TRUE
	}

addJSFromUrls :: ![String] !(?JSFun) !JSVal !*JSWorld -> *JSWorld
addJSFromUrls jss mbCallback val w = addJSFromUrls` jss {} w
where
	addJSFromUrls` [] _ w = case mbCallback of
		?Just cb -> (cb .$! ()) w
		?None    -> w
	addJSFromUrls` [js:jss] _ w
		# (addCallback, w) = jsWrapFun (addJSFromUrls` jss) val w
		= addJSFromUrl js (?Just addCallback) val w

jsTrace :: !a !.b -> .b | toString a
jsTrace s x = jsTraceVal (JSString (toString s)) x

jsTraceVal :: !JSVal !.a -> .a
jsTraceVal v x
	| eval_js (js_val_to_string (JSCall (JSVar "console.log") {v}))
		= x
		= abort_with_node v

set_js :: !*String !*String -> Bool
set_js var val = code {
	instruction 1
	pop_a 2
	pushB TRUE
}

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 s = code {
	instruction 3
	fill_a 0 1
	pop_a 1
}

share :: !JSVal !a -> JSVal
share (JSRef r) x = JSCleanRef (get_shared_value_index x r)
where
	get_shared_value_index :: !a !Int -> Int
	get_shared_value_index _ _ = code {
		instruction 4
		pop_a 1
	}
share _ _ = abort "when sharing a value from Clean to JS it must be linked to an iTasks component\n"

// This function is meant to be called with a (node containing) JSVal(s) as its
// argument, and then ensures that a references to that value(s) remain
// reachable by the garbage collector. This is needed when a JSVal is converted
// to a string and then sent to JavaScript. If it contains a JSRef, the
// reference must not be garbage collected, but computing the string to send to
// JavaScript may trigger a garbage collection after the JSRef has been
// visited. This function, when used properly, makes sure that the JSRef stays
// in memory until after the call to JavaScript.
abort_with_node :: !a -> .b
abort_with_node _ = abort "abort_with_node\n"
