Verified Commit 4f6e27f3 authored by Camil Staps's avatar Camil Staps 🙂

Add functionality to return javascript values back to Clean

parent 8861fde4
......@@ -35,22 +35,23 @@ where
initUI :: !(JSObj ()) !*JSWorld -> *JSWorld
initUI comp w
# w = (jsGlobal "console.log" .$! (1,2,3)) w
# (v,w) = (jsGlobal "Math.floor" .$ 17) w
# (jsInitDOMEl,w) = jsWrapFun (initDOMEl comp) w
# w = (comp .# "initDOMEl" .= jsInitDOMEl) w
# (jsAfterInitDOM,w) = jsWrapFun afterInitDOM w
# w = (comp .# "afterInitDOM" .= jsAfterInitDOM) w
= w
where
initDOMEl :: !(JSObj ()) !*JSWorld -> (!JSVal a, !*JSWorld)
initDOMEl :: !(JSObj ()) !*JSWorld -> *JSWorld
initDOMEl comp w
# w = (comp .# "domEl.value" .= toJS (MyReverse 1000)) w
# w = (comp .# "afterInitDOM" .$! ()) w
= (jsNull,w)
= w
afterInitDOM :: !*JSWorld -> (!JSVal a, !*JSWorld)
afterInitDOM :: !*JSWorld -> *JSWorld
afterInitDOM w
# w = (jsGlobal "console.log" .$! "element initialized") w
= (jsNull,w)
= w
genUI :: !UIAttributes !DataPath !(EditMode s) !*VSt -> *(!MaybeErrorString (!UI, !s), !*VSt)
genUI attr dp mode vst = case editModeValue mode of
......
......@@ -164,5 +164,5 @@ withClientSideInit initUI genUI attr dp val vst=:{VSt|taskId} = case genUI attr
-> (Error e, {VSt|vst & iworld = iworld})
e -> e
where
initUI` :: Int *JSWorld -> *JSWorld
initUI` :: !Int !*JSWorld -> *JSWorld
initUI` ref_to_js_elem world = initUI (referenceToJS ref_to_js_elem) world
......@@ -12,7 +12,7 @@ from StdMaybe import :: Maybe
:: JSFunction a
class toJS a :: !a -> JSVal b
instance toJS Int, String
instance toJS Int, Bool, String, (JSVal b), (Maybe b) | toJS b
/**
* Access properties of a JavaScript value.
......@@ -22,18 +22,24 @@ class (.#) infixl 3 attr :: !(JSVal a) !attr -> JSVal b
instance .# String // object access; may contain dots
instance .# Int // array access
(.=) infixl 1 :: !(JSObj a) !(JSVal b) !*JSWorld -> *JSWorld
(.?) infixl 1 :: !(JSVal a) !*JSWorld -> *(!JSVal r, !*JSWorld)
(.=) infixl 1 :: !(JSObj a) !b !*JSWorld -> *JSWorld | toJS b
class toJSArgs a :: !a -> [JSVal a]
instance toJSArgs Int, String, ()
instance toJSArgs Int, Bool, String, (JSVal b), (Maybe b) | toJS b, ()
instance toJSArgs (a,b) | toJS a & toJS b
instance toJSArgs (a,b,c) | toJS a & toJS b & toJS c
instance toJSArgs (a,b,c,d) | toJS a & toJS b & toJS c & toJS d
instance toJSArgs (a,b,c,d,e) | toJS a & toJS b & toJS c & toJS d & toJS e
instance toJSArgs (a,b,c,d,e,f) | toJS a & toJS b & toJS c & toJS d & toJS e & toJS f
(.$) infixl 2 :: !(JSFun a) !b !*JSWorld -> *(!JSVal c, !*JSWorld) | toJSArgs b
(.$!) infixl 2 :: !(JSFun a) !b !*JSWorld -> *JSWorld | toJSArgs b
jsNew :: !String !a !*JSWorld -> *(!JSVal b, !*JSWorld) | toJSArgs a
jsEmptyObject :: !*JSWorld -> *(!JSVal a, !*JSWorld)
jsGlobal :: !String -> JSVal a
jsNull :== jsGlobal "null"
......
......@@ -8,10 +8,12 @@ import Text
:: JSVal a
= JSInt !Int
| JSBool !Bool
| JSString !String
| JSRef !Int // a reference to shared_js_values
| JSCleanRef !Int // a reference to shared_clean_values
| JSVar !String
| JSNull
| E.b c: JSSel !(JSVal b) !(JSVal c) // b[c]
| E.b: JSSelPath !(JSVal b) !String // b.path1.path2...pathn
......@@ -23,29 +25,46 @@ instance toString (JSVal a)
where
toString v = case v of
JSInt i -> toString i
JSBool b -> if b "true" "false"
JSString s -> "'"+++s+++"'" // TODO escape
JSRef i -> "abc_interpreter.shared_js_values["+++toString i+++"]"
JSCleanRef i -> "abc_interpreter.apply_to_clean_value("+++toString i+++")"
JSVar v -> v
JSNull -> "null"
JSSel obj attr -> toString obj+++"["+++toString attr+++"]"
JSSelPath obj path -> toString obj+++"."+++path
js_set :: !(JSVal a) !(JSVal b) !*JSWorld -> *JSWorld
js_set var val w = case eval_js (toString var+++"="+++toString val) of
True -> w
instance toJS Int where toJS i = JSInt i
instance toJS Bool where toJS b = JSBool b
instance toJS String where toJS s = JSString s
instance toJS (JSVal b) where toJS val = cast val
instance toJS (Maybe b) | toJS b
where
toJS val = case val of
Just v -> toJS v
Nothing -> JSNull
instance .# String where .# obj path = JSSelPath obj path
instance .# Int where .# arr i = JSSel arr (JSInt i)
(.=) infixl 1 :: !(JSObj a) !(JSVal b) !*JSWorld -> *JSWorld
(.=) sel v w = js_set sel v w
(.?) infixl 1 :: !(JSVal a) !*JSWorld -> *(!JSVal r, !*JSWorld)
(.?) sel w = (eval_js_with_return_value (toString sel), w)
(.=) infixl 1 :: !(JSObj a) !b !*JSWorld -> *JSWorld | toJS b
(.=) sel v w = case eval_js (toString sel+++"="+++toString (toJS v)) of
True -> w
instance toJSArgs Int where toJSArgs i = [toJS i]
instance toJSArgs Bool where toJSArgs b = [toJS b]
instance toJSArgs String where toJSArgs s = [toJS s]
instance toJSArgs (JSVal b) where toJSArgs v = [cast v]
instance toJSArgs (Maybe b) | toJS b
where
toJSArgs v = case v of
Just v -> [toJS v]
Nothing -> [JSNull]
instance toJSArgs () where toJSArgs _ = []
instance toJSArgs (a,b) | toJS a & toJS b
......@@ -63,12 +82,25 @@ where toJSArgs (a,b,c,d,e) = [toJS a, toJS b, toJS c, toJS d, toJS e]
instance toJSArgs (a,b,c,d,e,f) | toJS a & toJS b & toJS c & toJS d & toJS e & toJS f
where toJSArgs (a,b,c,d,e,f) = [toJS a, toJS b, toJS c, toJS d, toJS e, toJS f]
(.$) infixl 2 :: !(JSFun a) !b !*JSWorld -> *(!JSVal c, !*JSWorld) | toJSArgs b
(.$) f args w = (eval_js_with_return_value call, w)
where
call = toString f+++"("+++join "," [toString a \\ a <- toJSArgs args]+++")"
(.$!) infixl 2 :: !(JSFun a) !b !*JSWorld -> *JSWorld | toJSArgs b
(.$!) f args w = case eval_js call of
True -> w
where
call = toString f+++"("+++join "," [toString a \\ a <- toJSArgs args]+++")"
jsNew :: !String !a !*JSWorld -> *(!JSVal b, !*JSWorld) | toJSArgs a
jsNew cons args w = (eval_js_with_return_value call, w)
where
call = "new "+++cons+++"("+++join "," [toString a \\ a <- toJSArgs args]+++")"
jsEmptyObject :: !*JSWorld -> *(!JSVal a, !*JSWorld)
jsEmptyObject w = (store_js_value "{}", w)
jsGlobal :: !String -> JSVal a
jsGlobal s = JSVar s
......@@ -111,15 +143,37 @@ eval_js s = code {
pushB TRUE
}
// TODO: this value may live on the heap, so the garbage collector should
// inspect the references in the JavaScript world and not remove shared values.
eval_js_with_return_value :: !String -> JSVal a
eval_js_with_return_value s = code {
instruction 2
eq_desc dINT 0 0
jmp_true return_int
print "eval_js_with_return_value: return type unknown\n"
halt
:return_int
repl_r_args 0 1
fill_r e_iTasks.UI.JS.Interface_kJSInt 0 1 0 0 0
jmp return
:return
}
store_js_value :: !String -> JSVal a
store_js_value s = JSRef (eval_and_store s)
where
eval_and_store :: !String -> Int
eval_and_store _ = code {
pushI 0 | to return the result
instruction 3
pop_a 1
}
share :: !a -> JSVal b
share x = JSCleanRef (get_shared_value_index x)
where
get_shared_value_index :: !a -> Int
get_shared_value_index _ = code {
pushI 0 | to return the result
instruction 2
instruction 4
pop_a 1
}
......
......@@ -84,6 +84,53 @@ const abc_interpreter={
};
},
copy_js_to_clean: function (values, asp, hp, hp_free) {
for (var i=values.length-1; i>=0; i--) {
asp+=8;
if (typeof values[i]=='number') {
// TODO use small integers
// TODO check garbage collection
if (Number.isInteger(values[i])) {
abc_interpreter.memory_array[asp/4]=hp;
abc_interpreter.memory_array[hp/4]=26*8+2; // INT
abc_interpreter.memory_array[hp/4+2]=values[i]; // TODO also support >32-bit
hp+=16;
hp_free-=2;
} else {
throw 'Cannot pass non-integral numbers to Clean yet'; // TODO
}
} else if ('abc_type' in values[i]) {
switch (values[i].abc_type) {
case 'SharedCleanValue':
abc_interpreter.memory_array[asp/4]=abc_interpreter.shared_clean_values[values[i].index];
break;
case 'JSWorld':
abc_interpreter.memory_array[asp/4]=(31+17*2)*8; // INT 17
break;
default:
throw ('unknown abc_type '+values[i].abc_type);
}
} else if ('domEl' in values[i]) { /* probably an iTasks.Component; TODO: come up with a better check for this */
// TODO: check if garbage collection is needed
abc_interpreter.memory_array[asp/4]=hp;
abc_interpreter.memory_array[hp/4]=661*8+2; // DOMNode type
abc_interpreter.memory_array[hp/4+2]=abc_interpreter.shared_js_values.length;
abc_interpreter.shared_js_values.push(values[i]);
hp+=16;
hp_free-=2;
} else {
console.log(values[i]);
throw 'Could not pass the above value to Clean';
}
}
return {
asp: asp,
hp: hp,
hp_free: hp_free,
};
},
get_clean_string: function (hp_ptr) {
var size=abc_interpreter.memory_array[hp_ptr/4+2];
var string_buffer=new Uint8Array(abc_interpreter.memory.buffer, hp_ptr+16);
......@@ -159,7 +206,7 @@ abc_interpreter.loading_promise=fetch('js/app.pbc').then(function(resp){
debug_instr: function (addr, instr) {
console.log(addr,(addr/8-abc_interpreter.code_offset)+'\t'+abc_instructions[instr]);
},
handle_illegal_instr: function (pc, instr, asp, bsp, csp, hp) {
handle_illegal_instr: function (pc, instr, asp, bsp, csp, hp, hp_free) {
if (abc_instructions[instr]=='instruction') {
const arg=abc_interpreter.memory_array[(pc+8)/4];
switch (arg) {
......@@ -170,7 +217,18 @@ abc_interpreter.loading_promise=fetch('js/app.pbc').then(function(resp){
console.log('eval',string);
Function(string)();
break;
case 2: /* iTasks.UI.JS.Interface: share */
case 2:
var string=abc_interpreter.get_clean_string(abc_interpreter.memory_array[asp/4]);
console.log('eval',string);
var result=eval(string);
var copied=abc_interpreter.copy_js_to_clean([result], asp-8, hp, hp_free);
abc_interpreter.interpreter.instance.exports.set_hp(copied.hp);
abc_interpreter.interpreter.instance.exports.set_hp_free(copied.hp_free);
break;
case 3: /* TODO: iTasks.UI.JS.Interface: store_js_value */
throw 'store_js_value';
break;
case 4: /* iTasks.UI.JS.Interface: share */
abc_interpreter.memory_array[bsp/4]=abc_interpreter.shared_clean_values.length;
abc_interpreter.shared_clean_values.push(abc_interpreter.memory_array[asp/4]);
break;
......@@ -188,7 +246,8 @@ abc_interpreter.loading_promise=fetch('js/app.pbc').then(function(resp){
var callback=abc_interpreter.get_clean_string(abc_interpreter.memory_array[asp/4-2]);
var js=document.createElement('script');
js.type='text/javascript';
js.onload=Function(callback+'();');
if (callback.length>0)
js.onload=Function(callback+'();');
console.log(url,callback,js);
document.head.appendChild(js);
js.src=url;
......@@ -290,32 +349,10 @@ abc_interpreter.loading_promise=fetch('js/app.pbc').then(function(resp){
var hp=abc_interpreter.interpreter.instance.exports.get_hp();
var hp_free=abc_interpreter.interpreter.instance.exports.get_hp_free();
for (var i=arguments.length-1; i>=0; i--) {
asp+=8;
if ('abc_type' in arguments[i]) {
switch (arguments[i].abc_type) {
case 'JSWorld':
abc_interpreter.memory_array[asp/4]=(31+17*2)*8; // INT 17
break;
case 'SharedCleanValue':
abc_interpreter.memory_array[asp/4]=abc_interpreter.shared_clean_values[arguments[i].index];
break;
default:
throw ('unknown abc_type '+arguments[i].abc_type);
}
} else if ('domEl' in arguments[i]) { /* probably an iTasks.Component; TODO: come up with a better check for this */
// TODO: check if garbage collection is needed
abc_interpreter.memory_array[asp/4]=hp;
abc_interpreter.memory_array[hp/4]=661*8+2; // DOMNode type
abc_interpreter.memory_array[hp/4+2]=abc_interpreter.shared_js_values.length;
abc_interpreter.shared_js_values.push(arguments[i]);
hp+=16;
hp_free-=2;
} else {
console.log(arguments[i]);
throw 'Could not pass the above value to Clean';
}
}
var copied=abc_interpreter.copy_js_to_clean(arguments, asp, hp, hp_free);
asp=copied.asp;
hp=copied.hp;
hp_free=copied.hp_free;
var csp=abc_interpreter.interpreter.instance.exports.get_csp();
abc_interpreter.memory_array[csp/4]=659*8; // instruction 0; to return
......@@ -323,6 +360,10 @@ abc_interpreter.loading_promise=fetch('js/app.pbc').then(function(resp){
var start=(97+arguments.length)*8; // jmp_apn as appropriate; TODO: fix for case where arguments.length=1
// TODO: it would be useful to have a check here whether the jmp_ap will be saturated.
// If not, that may indicate a bug in the Clean code, but the type system cannot not catch that.
// See for instance the removal of the 'a' argument in the initDOMEl of Pikaday.
abc_interpreter.interpreter.instance.exports.set_pc(start);
abc_interpreter.interpreter.instance.exports.set_asp(asp);
abc_interpreter.interpreter.instance.exports.set_csp(csp);
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment