Passing HTML element to callback in swipl-wasm

Hi, I am not able to figure out, how to properly pass HTML element to bind/4 from library(dom).
The minimum HTML example is like this:

<html>
  <body>
    <script src="https://SWI-Prolog.github.io/npm-swipl-wasm/latest/index.js">
    </script>
    <script>
      (async () => {
        const swipl = await SWIPL({ arguments: ["-q"] });
        swipl.prolog.load_scripts()
      })();
    </script>
    <script id="main" type="text/prolog">
      :- use_module(library(dom)).
      
      :- initialization(run).

      run :-
        create(button, Button),
        Button.innerHTML := "click",
        _ := document.body.appendChild(Button),
        bind(Button, click, Event, test(Event)),
        bind(Button, click, _, test(Button)).

      test(Obj) :-
        _ := alert(Obj).
    </script>
  </body>
</html>

After the click on button the first call test(Event) succeeds, but the second call test(Button) ends with error (visible in browser’s console):

Syntax error: Operator expected
user:test(
** here **
<js_HTMLButtonElement>(1)) . 

As is, bind/4 creates a a JavaScript event listener that invokes prolog.query() using a textutal query created from the goal of the bind/4 call. This only supports passing the event. As references to JavaScript object are represented as Prolog blobs, there is no textual representation.

Some redesign of the bind primitive would be needed to allow for that. I’m do not know whether that it a good or bad idea. In this case, passing the event and asking the event for the target is probably the way to go. Is this a simplification of a more general problem.

1 Like

Thank you for the explanation. Sometimes an event on one element should trigger some action on different element, so in those cases I can’t use event.target. But I still can assign an id to the desired target element and pass this ID to the goal through bind/4 and then acess the target with get_by_id/2.

I agree it would make sense. Roughly, I think there are three ways to find UI components:

  • Directly from a variable in the code (as you tried)
  • Using an id element
  • Navigate from the .target through the DOM using some property (the class, element type, some property, …)

I don’t like id as they live in a global name space. This means we must avoid collisions and creating two instances of some DOM sub-tree is not possible (well, there are some options in the current HTML standard). Navigating typically has my preference. Using variables it as least as attractive though. Need to give this some thought.

I have encountered another error which seems to have some connection to bind/4 as well:

<html>
  <body>
    <script src="https://SWI-Prolog.github.io/npm-swipl-wasm/latest/index.js">
    </script>
    <script>
      (async () => {
        const swipl = await SWIPL({ arguments: ["-q"] });
        swipl.prolog.load_scripts()
      })();
    </script>
    <script id="main" type="text/prolog">
      :- use_module(library(dom)).
      :- use_module(library(strings)).
      
      :- initialization(test_after).

      :- js_script({|string||
        function after(time) {
          return new Promise(resolve => setTimeout(_ => resolve(), time))
        }|}, []).

      after(Time) :-
        Promise := after(Time),
        await(Promise, _).

      test_after :-
        after(250), % this is ok
        create(button, Button),
        set_html(Button, click),
        Body := document.body,
        append_child(Body, Button),
        bind(Button, click, _Event, on_click).

      on_click :-
        after(250). % this ends with error
    </script>
  </body>
</html>

The after/1 is an attempt to have a non-blocking version of sleep/1. (Most probably it is not the right approach). The first call to after/1 in test_after/0 works OK, but the second call through bind/4 to on_click/0 gives (after clicking on button) a prompt dialog in the browser and bunch of errors in the console.
I tested on Ubuntu 22.04, Windows 10; Chrome, Firefox; and online swipl-wasm build from the code above as well as freshly compiled build (version 9.1.21-88-gaba626a7c). The results seems to be the same in all the tests.

browser console log
index.js:1 [PROLOG SYSTEM ERROR: at Tue Jan 23 22:36:53 2024
put_char @ index.js:1
write @ index.js:1
write @ index.js:1
doWritev @ index.js:1
_fd_write @ index.js:1
$func1375 @ 01ec4d62:0xe213b
$func2654 @ 01ec4d62:0x1855f4
$func379 @ 01ec4d62:0x2a482
$func491 @ 01ec4d62:0x42fb6
$func62 @ 01ec4d62:0x46fe
$func157 @ 01ec4d62:0xf065
$func509 @ 01ec4d62:0x479c8
$func79 @ 01ec4d62:0x9429
$func403 @ 01ec4d62:0x2d170
$func1918 @ 01ec4d62:0x1441ee
invoke_iii @ index.js:1
$func240 @ 01ec4d62:0x17d9a
$sa @ 01ec4d62:0x150ac4
Module._PL_next_solution @ index.js:1
next @ index.js:1
once @ index.js:1
(anonymous) @ index.js:1
index.js:1 	After trail: relocation cells = 7; relocated_cells = 6
put_char @ index.js:1
write @ index.js:1
write @ index.js:1
doWritev @ index.js:1
_fd_write @ index.js:1
$func1375 @ 01ec4d62:0xe213b
$func2654 @ 01ec4d62:0x1855f4
$func379 @ 01ec4d62:0x2a482
$func491 @ 01ec4d62:0x42fb6
$func157 @ 01ec4d62:0xf071
$func509 @ 01ec4d62:0x479c8
$func79 @ 01ec4d62:0x9429
$func403 @ 01ec4d62:0x2d170
$func1918 @ 01ec4d62:0x1441ee
invoke_iii @ index.js:1
$func240 @ 01ec4d62:0x17d9a
$sa @ 01ec4d62:0x150ac4
Module._PL_next_solution @ index.js:1
next @ index.js:1
once @ index.js:1
(anonymous) @ index.js:1
index.js:1 
put_char @ index.js:1
write @ index.js:1
write @ index.js:1
doWritev @ index.js:1
_fd_write @ index.js:1
$func1375 @ 01ec4d62:0xe213b
$func2654 @ 01ec4d62:0x1855f4
$func379 @ 01ec4d62:0x2a482
$func491 @ 01ec4d62:0x42fb6
$func62 @ 01ec4d62:0x46fe
$func157 @ 01ec4d62:0xf09a
$func509 @ 01ec4d62:0x479c8
$func79 @ 01ec4d62:0x9429
$func403 @ 01ec4d62:0x2d170
$func1918 @ 01ec4d62:0x1441ee
invoke_iii @ index.js:1
$func240 @ 01ec4d62:0x17d9a
$sa @ 01ec4d62:0x150ac4
Module._PL_next_solution @ index.js:1
next @ index.js:1
once @ index.js:1
(anonymous) @ index.js:1
index.js:1 [While in 1-th garbage collection]
put_char @ index.js:1
write @ index.js:1
write @ index.js:1
doWritev @ index.js:1
_fd_write @ index.js:1
$func1375 @ 01ec4d62:0xe213b
$func2654 @ 01ec4d62:0x1855f4
$func379 @ 01ec4d62:0x2a482
$func491 @ 01ec4d62:0x42fb6
$func62 @ 01ec4d62:0x46fe
$func157 @ 01ec4d62:0xf09a
$func509 @ 01ec4d62:0x479c8
$func79 @ 01ec4d62:0x9429
$func403 @ 01ec4d62:0x2d170
$func1918 @ 01ec4d62:0x1441ee
invoke_iii @ index.js:1
$func240 @ 01ec4d62:0x17d9a
$sa @ 01ec4d62:0x150ac4
Module._PL_next_solution @ index.js:1
next @ index.js:1
once @ index.js:1
(anonymous) @ index.js:1
index.js:1 
put_char @ index.js:1
write @ index.js:1
write @ index.js:1
doWritev @ index.js:1
_fd_write @ index.js:1
$func1375 @ 01ec4d62:0xe213b
$func2654 @ 01ec4d62:0x1855f4
$func379 @ 01ec4d62:0x2a482
$func491 @ 01ec4d62:0x42fb6
$func62 @ 01ec4d62:0x46fe
$func157 @ 01ec4d62:0xf0a9
$func509 @ 01ec4d62:0x479c8
$func79 @ 01ec4d62:0x9429
$func403 @ 01ec4d62:0x2d170
$func1918 @ 01ec4d62:0x1441ee
invoke_iii @ index.js:1
$func240 @ 01ec4d62:0x17d9a
$sa @ 01ec4d62:0x150ac4
Module._PL_next_solution @ index.js:1
next @ index.js:1
once @ index.js:1
(anonymous) @ index.js:1
index.js:1 /swipl-devel/src/os/pl-cstack.c:1047 C-stack dumps are not supported on this platform
put_char @ index.js:1
write @ index.js:1
write @ index.js:1
doWritev @ index.js:1
_fd_write @ index.js:1
$func1375 @ 01ec4d62:0xe213b
$func2654 @ 01ec4d62:0x1855f4
$func379 @ 01ec4d62:0x2a482
$func84 @ 01ec4d62:0x980c
$func676 @ 01ec4d62:0x5cd37
$func157 @ 01ec4d62:0xf0ac
$func509 @ 01ec4d62:0x479c8
$func79 @ 01ec4d62:0x9429
$func403 @ 01ec4d62:0x2d170
$func1918 @ 01ec4d62:0x1441ee
invoke_iii @ index.js:1
$func240 @ 01ec4d62:0x17d9a
$sa @ 01ec4d62:0x150ac4
Module._PL_next_solution @ index.js:1
next @ index.js:1
once @ index.js:1
(anonymous) @ index.js:1
2index.js:1 
put_char @ index.js:1
write @ index.js:1
write @ index.js:1
doWritev @ index.js:1
_fd_write @ index.js:1
$func1375 @ 01ec4d62:0xe213b
$func2654 @ 01ec4d62:0x1855f4
$func379 @ 01ec4d62:0x2a482
$func491 @ 01ec4d62:0x42fb6
$func62 @ 01ec4d62:0x46fe
$func157 @ 01ec4d62:0xf0ba
$func509 @ 01ec4d62:0x479c8
$func79 @ 01ec4d62:0x9429
$func403 @ 01ec4d62:0x2d170
$func1918 @ 01ec4d62:0x1441ee
invoke_iii @ index.js:1
$func240 @ 01ec4d62:0x17d9a
$sa @ 01ec4d62:0x150ac4
Module._PL_next_solution @ index.js:1
next @ index.js:1
once @ index.js:1
(anonymous) @ index.js:1
index.js:1 PROLOG STACK:
put_char @ index.js:1
write @ index.js:1
write @ index.js:1
doWritev @ index.js:1
_fd_write @ index.js:1
$func1375 @ 01ec4d62:0xe213b
$func2654 @ 01ec4d62:0x1855f4
$func379 @ 01ec4d62:0x2a482
$func491 @ 01ec4d62:0x42fb6
$func62 @ 01ec4d62:0x46fe
$func157 @ 01ec4d62:0xf0ba
$func509 @ 01ec4d62:0x479c8
$func79 @ 01ec4d62:0x9429
$func403 @ 01ec4d62:0x2d170
$func1918 @ 01ec4d62:0x1441ee
invoke_iii @ index.js:1
$func240 @ 01ec4d62:0x17d9a
$sa @ 01ec4d62:0x150ac4
Module._PL_next_solution @ index.js:1
next @ index.js:1
once @ index.js:1
(anonymous) @ index.js:1
index.js:1   [0] system:$c_call_prolog/0 <no clause>
put_char @ index.js:1
write @ index.js:1
write @ index.js:1
doWritev @ index.js:1
_fd_write @ index.js:1
$func1375 @ 01ec4d62:0xe213b
$func2654 @ 01ec4d62:0x1855f4
$func379 @ 01ec4d62:0x2a482
$func491 @ 01ec4d62:0x42fb6
$func62 @ 01ec4d62:0x46fe
$func1029 @ 01ec4d62:0x8bcb1
$func827 @ 01ec4d62:0x6dd33
$func157 @ 01ec4d62:0xf0c1
$func509 @ 01ec4d62:0x479c8
$func79 @ 01ec4d62:0x9429
$func403 @ 01ec4d62:0x2d170
$func1918 @ 01ec4d62:0x1441ee
invoke_iii @ index.js:1
$func240 @ 01ec4d62:0x17d9a
$sa @ 01ec4d62:0x150ac4
Module._PL_next_solution @ index.js:1
next @ index.js:1
once @ index.js:1
(anonymous) @ index.js:1
index.js:1 ]
put_char @ index.js:1
write @ index.js:1
write @ index.js:1
doWritev @ index.js:1
_fd_write @ index.js:1
$func1375 @ 01ec4d62:0xe213b
$func2654 @ 01ec4d62:0x1855f4
$func379 @ 01ec4d62:0x2a482
$func491 @ 01ec4d62:0x42fb6
$func62 @ 01ec4d62:0x46fe
$func157 @ 01ec4d62:0xf0cf
$func509 @ 01ec4d62:0x479c8
$func79 @ 01ec4d62:0x9429
$func403 @ 01ec4d62:0x2d170
$func1918 @ 01ec4d62:0x1441ee
invoke_iii @ index.js:1
$func240 @ 01ec4d62:0x17d9a
$sa @ 01ec4d62:0x150ac4
Module._PL_next_solution @ index.js:1
next @ index.js:1
once @ index.js:1
(anonymous) @ index.js:1
index.js:1 
put_char @ index.js:1
write @ index.js:1
write @ index.js:1
doWritev @ index.js:1
_fd_write @ index.js:1
$func1375 @ 01ec4d62:0xe213b
$func2654 @ 01ec4d62:0x1855f4
$func379 @ 01ec4d62:0x2a482
$func491 @ 01ec4d62:0x42fb6
$func62 @ 01ec4d62:0x46fe
$func157 @ 01ec4d62:0xf10c
$func509 @ 01ec4d62:0x479c8
$func79 @ 01ec4d62:0x9429
$func403 @ 01ec4d62:0x2d170
$func1918 @ 01ec4d62:0x1441ee
invoke_iii @ index.js:1
$func240 @ 01ec4d62:0x17d9a
$sa @ 01ec4d62:0x150ac4
Module._PL_next_solution @ index.js:1
next @ index.js:1
once @ index.js:1
(anonymous) @ index.js:1
index.js:1 [pid=42] Action? EOF: exit (status 134)
put_char @ index.js:1
write @ index.js:1
write @ index.js:1
doWritev @ index.js:1
_fd_write @ index.js:1
$func1375 @ 01ec4d62:0xe213b
$func2654 @ 01ec4d62:0x1855f4
$func379 @ 01ec4d62:0x2a482
$func491 @ 01ec4d62:0x42fb6
$func62 @ 01ec4d62:0x46fe
$func157 @ 01ec4d62:0xf13f
$func509 @ 01ec4d62:0x479c8
$func79 @ 01ec4d62:0x9429
$func403 @ 01ec4d62:0x2d170
$func1918 @ 01ec4d62:0x1441ee
invoke_iii @ index.js:1
$func240 @ 01ec4d62:0x17d9a
$sa @ 01ec4d62:0x150ac4
Module._PL_next_solution @ index.js:1
next @ index.js:1
once @ index.js:1
(anonymous) @ index.js:1
index.js:1 Uncaught RuntimeError: memory access out of bounds
    at 01ec4d62:0x12fed
    at 01ec4d62:0x14ef40
    at invoke_iii (index.js:1:10841666)
    at 01ec4d62:0x17d9a
    at 01ec4d62:0x8b480
    at 01ec4d62:0x8563d
    at 01ec4d62:0xcb100
    at 01ec4d62:0xf15e
    at 01ec4d62:0x479c8
    at 01ec4d62:0x9429

I’ve noticed, that the promise-based sleep is already implemented in SWI-Prolog -- JavaScript Promise that can be aborted. But the error is the same. This works:

Sleep := prolog.promise_sleep(5), await(Sleep, _).

when called directly, but it breaks with PROLOG SYSTEM ERROR if it is called from goal through the bind/4

So I dug a little deeper with this and I have two points:

  1. Javascript bind function calls prolog.query, but to be able to use await/2 in “bound goal”, it have to be called with prolog.forEach instead. I’m not sure if it’s general issue in bind function, or if I just need to define custom bind function when I need to call await/2.

  2. There seems to be some error with using library(strings) quasi quotations. If await/2 is called in bound goal through standard bind/4 and there is defined something like this:

:- js_script("null", _).

call await/2 in bound goal ends with error:

'$await'/2: No permission to execute vmi `'I_YIELD'' (not an engine)

which can be resolved with using prolog.forEach. Of course the error is always the same in case no js_script/2 is used.
But if quasi qotations are used like this:

:- use_module(library(strings)).
:- js_script({|string||null|}, _).

call await/2 in bound goal ends with PROLOG SYSTEM ERROR and bunch of errors I’ve already posted before.

Sorry for the non-response. It should be noted that SWI-Prolog’s await/2, or more general its notion of async procedures is still rather limited. Worse, the system cannot (yet) properly test that it is trying to do something illegal. Part of these problems are probably related to this.

Prolog’s VM is written in C and translated using EMSDK to WASM. That code generally is not async. I think I saw a remark that there is (experimental?) support to compile the code as async, but that probably won’t help us either due to performance reasons. The VM does implement an instruction that causes the VM to stop in a way that it can be restarted. The stop instruction is I_YIELD and that cannot be executed if the VM calls itself recursively, i.e., Prolog calls C, which calls Prolog again. That is (I think) your permission error: parsing a quasi quotation calls Prolog from the C based reader, so you cannot yield from there. await/2 uses I_YIELD.

The second problem is that the VM cannot be involved in two threads of execution. I.e., if some JavaScript function calls Prolog and Prolog uses await/2, no other JavaScript function can do the same before the first completes. There is, if I recall correctly, no guard against this. This makes async calls from a bind hazardous.

The latter can be fixed by detecting this and creating a new engine to deal with the “overlapping” async thread of execution. Originally, engines only worked in the multi-threaded version. There is now experimental code to use engines in the single threaded version.

The WASM version is an interesting start and already quite useful. It does need more work though. Help, either attacking these issues or getting funding to get this resolved is welcome.

1 Like

I didn’t expect a response anytime soon, if at all. I really appreciate all your work and am always wondering how you can manage to work on such a complex system and still be able to address so many issues here on discourse.

Thank you for your explanation. There are still topics I need to learn a lot more about, but hopefully I will come across something with which be able to contribute somehow. It’s just a hobby project with no money involved, so I have no real funds for this.