Merge branch 'master' into flame

Cargo.lock

@@ -379,16 +379,6 @@ dependencies = [
  "wasm-bindgen",
 ]
 
-[[package]]
-name = "console_log"
-version = "1.0.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "be8aed40e4edbf4d3b4431ab260b63fdc40f5780a4766824329ea0f1eefe3c0f"
-dependencies = [
- "log",
- "web-sys",
-]
-
 [[package]]
 name = "core-foundation"
 version = "0.9.3"
@@ -2471,7 +2461,6 @@ dependencies = [
  "bytes",
  "chrono",
  "console_error_panic_hook",
- "console_log",
  "cpu-time",
  "criterion",
  "crossterm",
@@ -2488,6 +2477,7 @@ dependencies = [
  "hostname",
  "iai-callgrind",
  "indexmap 1.9.3",
+ "js-sys",
  "lazy_static",
  "lexical",
  "libc",

Cargo.toml

@@ -95,11 +95,11 @@ tokio = { version = "1.28.2", features = [
 
 [target.'cfg(all(target_arch = "wasm32", target_os = "unknown"))'.dependencies]
 console_error_panic_hook = "0.1"
-console_log = "1.0"
 wasm-bindgen = "0.2.87"
 wasm-bindgen-futures = "0.4"
 serde-wasm-bindgen = "0.5"
 web-sys = { version = "0.3", features = ["Document", "Window", "Element"] }
+js-sys = "0.3"
 
 [target.'cfg(target_os = "wasi")'.dependencies]
 ring-wasi = { version = "0.16.25" }

build/instructions_template.rs

@@ -575,6 +575,8 @@ enum SystemClauseType {
     ForeignCall,
     #[strum_discriminants(strum(props(Arity = "2", Name = "$define_foreign_struct")))]
     DefineForeignStruct,
+    #[strum_discriminants(strum(props(Arity = "2", Name = "$js_eval")))]
+    JsEval,
     #[strum_discriminants(strum(props(Arity = "3", Name = "$predicate_defined")))]
     PredicateDefined,
     #[strum_discriminants(strum(props(Arity = "3", Name = "$strip_module")))]
@@ -1777,6 +1779,7 @@ fn generate_instruction_preface() -> TokenStream {
                     &Instruction::CallLoadForeignLib |
                     &Instruction::CallForeignCall |
                     &Instruction::CallDefineForeignStruct |
+                    &Instruction::CallJsEval |
                     &Instruction::CallPredicateDefined |
                     &Instruction::CallStripModule |
                     &Instruction::CallCurrentTime |
@@ -2012,6 +2015,7 @@ fn generate_instruction_preface() -> TokenStream {
                     &Instruction::ExecuteLoadForeignLib |
                     &Instruction::ExecuteForeignCall |
                     &Instruction::ExecuteDefineForeignStruct |
+                    &Instruction::ExecuteJsEval |
                     &Instruction::ExecutePredicateDefined |
                     &Instruction::ExecuteStripModule |
                     &Instruction::ExecuteCurrentTime |

src/codegen.rs

@@ -300,9 +300,10 @@ impl DebrayAllocator {
                         &self.var_data.records[var_num].allocation
                     {
                         self.mark_var_in_non_callable(var_num, term_loc, vr, code);
+                    } else {
+                        self.increment_running_count(var_num);
                     }
 
-                    self.increment_running_count(var_num);
                     RegType::Perm(p)
                 }
             }

src/lib.rs

@@ -51,7 +51,8 @@ use wasm_bindgen::prelude::*;
 #[wasm_bindgen]
 pub fn eval_code(s: &str) -> String {
     use machine::mock_wam::*;
-    use web_sys::console;
+
+    console_error_panic_hook::set_once();
 
     let mut wam = Machine::with_test_streams();
     let bytes = wam.test_load_string(s);

src/lib/builtins.pl

@@ -1173,8 +1173,13 @@ clause(H, B) :-
 % The clause will be inserted at the beginning of the module.
 asserta(Clause0) :-
     loader:strip_subst_module(Clause0, user, Module, Clause),
-    iso_ext:asserta(Module, Clause).
+    asserta_(Module, Clause).
 
+asserta_(Module, (Head :- Body)) :-
+    !,
+    '$asserta'(Module, Head, Body).
+asserta_(Module, Fact) :-
+    '$asserta'(Module, Fact, true).
 
 :- meta_predicate assertz(:).
 
@@ -1184,7 +1189,13 @@ asserta(Clause0) :-
 % The clase will be inserted at the end of the module.
 assertz(Clause0) :-
     loader:strip_subst_module(Clause0, user, Module, Clause),
-    iso_ext:assertz(Module, Clause).
+    assertz_(Module, Clause).
+
+assertz_(Module, (Head :- Body)) :-
+    !,
+    '$assertz'(Module, Head, Body).
+assertz_(Module, Fact) :-
+    '$assertz'(Module, Fact, true).
 
 
 :- meta_predicate retract(:).

src/lib/iso_ext.pl

@@ -17,9 +17,7 @@ but they're not part of the ISO Prolog standard at the moment.
                     succ/2,
                     call_nth/2,
                     countall/2,
-                    copy_term_nat/2,
+                    copy_term_nat/2]).
-                    asserta/2,
-                    assertz/2]).
 
 :- use_module(library(error), [can_be/2,
                                domain_error/3,
@@ -384,21 +382,3 @@ countall(Goal, N) :-
 copy_term_nat(Source, Dest) :-
     '$copy_term_without_attr_vars'(Source, Dest).
 
-%% asserta(Module, Rule_Fact).
-%
-% Similar to `asserta/1` but allows specifying a Module
-asserta(Module, (Head :- Body)) :-
-    !,
-    '$asserta'(Module, Head, Body).
-asserta(Module, Fact) :-
-    '$asserta'(Module, Fact, true).
-
-%% assertz(Module, Rule_Fact).
-%
-% Similar to `assertz/1` but allows specifying a Module
-assertz(Module, (Head :- Body)) :-
-    !,
-    '$assertz'(Module, Head, Body).
-assertz(Module, Fact) :-
-    '$assertz'(Module, Fact, true).
-

src/lib/time.pl

@@ -96,7 +96,7 @@ sleep(T) :-
 :- meta_predicate time(0).
 
 :- dynamic(time_id/1).
-:- dynamic(time_state/2).
+:- dynamic(time_state/3).
 
 time_next_id(N) :-
         (   retract(time_id(N0)) ->
@@ -111,9 +111,9 @@ time_next_id(N) :-
 %  Reports the execution time of Goal.
 
 time(Goal) :-
-        '$cpu_now'(T0),
+        cputime_inferences(T0, I0),
         time_next_id(ID),
-        setup_call_cleanup(asserta(time_state(ID, T0)),
+        setup_call_cleanup(asserta(time_state(ID, T0, I0)),
                            (   call_cleanup(catch(Goal, E, (report_time(ID),throw(E))),
                                             Det = true),
                                time_true(ID),
@@ -123,49 +123,72 @@ time(Goal) :-
                            ;   report_time(ID),
                                false
                            ),
-                           retract(time_state(ID, _))).
+                           retract(time_state(ID, _, _))).
+
+cputime_inferences(T, I) :-
+        '$cpu_now'(T),
+        '$inference_count'(I).
 
 time_true(ID) :-
         report_time(ID).
 time_true(ID)  :-
         % on backtracking, update the stored CPU time for this ID
-        retract(time_state(ID, _)),
+        retract(time_state(ID, _, _)),
-        '$cpu_now'(T0),
+        cputime_inferences(T0, I0),
-        asserta(time_state(ID, T0)),
+        asserta(time_state(ID, T0, I0)),
         false.
 
 report_time(ID) :-
-        time_state(ID, T0),
+        time_state(ID, T0, I0),
-        '$cpu_now'(T),
+        cputime_inferences(T, I),
         Time is T - T0,
+        Inferences0 is I - I0,
+        % we must subtract the number of inferences that time/1 itself takes;
+        % this may have to be adapted if the implementation changes,
+        % so that (for example) true/1 takes exactly 1 inference.
         (   bb_get('$answer_count', 0) ->
+            Inferences is Inferences0 - 60,
             Pre = "   ", Post = ""
-        ;   Pre = "", Post = "   "
+        ;   Inferences is Inferences0 - 9,
+            Pre = "", Post = "   "
         ),
-        format("~s% CPU time: ~3fs~n~s", [Pre,Time,Post]).
+        phrase((Pre,"% CPU time: ", format_("~3f", [Time]), "s, ",
+                format_("~U", [Inferences])," inference",s_if_necessary(Inferences),"\n",
+                Post), Cs),
+        format("~s", [Cs]).
+
+s_if_necessary(Inferences) -->
+        { compare(C, 1, Inferences) },
+        s_(C).
+
+s_(=) --> "".
+s_(<) --> "s".
+s_(>) --> " (exception?)".
 
 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 ?- time((true;false)).
-%@    % CPU time: 0.006s
+   % CPU time: 0.000s, 1 inference
-%@    true
+   true
-%@ ;  % CPU time: 0.001s
+;  % CPU time: 0.000s, 0 inference (exception?)
-%@    false.
+   false.
 
 :- time(use_module(library(clpz))).
-%@    % CPU time: 3.711s
+   % CPU time: 0.343s, 409_874 inferences
-%@    true.
+   true.
 
 :- time(use_module(library(lists))).
-%@    % CPU time: 0.006s
+   % CPU time: 0.000s, 19 inferences
-%@    true.
+   true.
 
 ?- time(member(X, "abc")).
-%@    % CPU time: 0.005s
+   % CPU time: 0.000s, 1 inference
-%@    X = a
+   X = a
-%@ ;  % CPU time: 0.000s
+;  % CPU time: 0.000s, 3 inferences
-%@    X = b
+   X = b
-%@ ;  % CPU time: 0.000s
+;  % CPU time: 0.000s, 3 inferences
-%@    X = c
+   X = c.
-%@ ;  % CPU time: 0.000s
+
-%@    false.
+?- time((repeat,false)).
+   % CPU time: 2.726s, 53_330_502 inferences
+   error('$interrupt_thrown',repl/0).
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

src/lib/wasm.pl

@@ -0,0 +1,29 @@
+/** Predicates for the WebAssembly platform
+
+This module contains predicates that are only available in
+the WASM (WebAssembly) version of Scryer Prolog.
+*/
+
+:- module(wasm, [js_eval/2]).
+
+:- use_module(library(error)).
+
+%% js_eval(+JsCode, -Result).
+%
+% Executes a JavaScript snippet `JsCode` using the platform
+% `eval` function. `Result` takes the return value of that code.
+% Strings, booleans, numbers, null and undefined are directly mapped to Prolog.
+% Arrays, objects, bigints, symbols and functions are not mapped.
+% Instead, a `js_{type}` atom will be returned.
+%
+% Example (on a browser):
+%
+% ```
+% ?- js_eval("prompt('What is your name?')", Name).
+%    % A prompt is showed, with a textbox.
+%    Name = "Whatever was written on the textbox".
+% ```
+js_eval(JsCode, Result) :-
+    must_be(chars, JsCode),
+    can_be(chars, Result),
+    '$js_eval'(JsCode, Result).

src/machine/copier.rs

@@ -18,6 +18,7 @@ pub trait CopierTarget: IndexMut<usize, Output = HeapCellValue> {
     fn store(&self, value: HeapCellValue) -> HeapCellValue;
     fn deref(&self, value: HeapCellValue) -> HeapCellValue;
     fn push(&mut self, value: HeapCellValue);
+    fn push_attr_var_queue(&mut self, attr_var_loc: usize);
     fn stack(&mut self) -> &mut Stack;
     fn threshold(&self) -> usize;
 }
@@ -73,7 +74,6 @@ impl<T: CopierTarget> CopyTermState<T> {
                     if h >= self.old_h {
                         *self.value_at_scan() = list_loc_as_cell!(h);
                         self.scan += 1;
-
                         return;
                     }
                 }
@@ -96,14 +96,19 @@ impl<T: CopierTarget> CopyTermState<T> {
             .store(self.target.deref(heap_loc_as_cell!(addr + 1)));
 
         if !cdr.is_var() {
+            // mark addr + 1 as a list back edge in the cdr of the list
             self.trail_list_cell(addr + 1, threshold);
+            self.target[addr + 1].set_mark_bit(true);
+            self.target[addr + 1].set_forwarding_bit(true);
         } else {
             let car = self
                 .target
                 .store(self.target.deref(heap_loc_as_cell!(addr)));
 
             if !car.is_var() {
+                // mark addr as a list back edge in the car of the list
                 self.trail_list_cell(addr, threshold);
+                self.target[addr].set_mark_bit(true);
             }
         }
 
@@ -178,6 +183,7 @@ impl<T: CopierTarget> CopyTermState<T> {
 
             for (threshold, list_loc) in iter {
                 self.target[threshold] = list_loc_as_cell!(self.target.threshold());
+                self.target.push_attr_var_queue(threshold - 1);
                 self.copy_attr_var_list(list_loc);
             }
         }
@@ -263,6 +269,7 @@ impl<T: CopierTarget> CopyTermState<T> {
     }
 
     fn copy_var(&mut self, addr: HeapCellValue) {
+        let index = addr.get_value() as usize;
         let rd = self.target.deref(addr);
         let ra = self.target.store(rd);
 
@@ -271,7 +278,20 @@ impl<T: CopierTarget> CopyTermState<T> {
                 if h >= self.old_h {
                     *self.value_at_scan() = ra;
                     self.scan += 1;
+                    return;
+                }
+            }
+            (HeapCellValueTag::Lis, h) => {
+                if h >= self.old_h && self.target[index].get_mark_bit() {
+                    *self.value_at_scan() = heap_loc_as_cell!(
+                        if ra.get_forwarding_bit() {
+                            h + 1
+                        } else {
+                            h
+                        }
+                    );
 
+                    self.scan += 1;
                     return;
                 }
             }
@@ -356,12 +376,16 @@ impl<T: CopierTarget> CopyTermState<T> {
         }
     }
 
-    fn unwind_trail(&mut self) {
+    fn unwind_trail(mut self) {
-        for (r, value) in self.trail.drain(0..) {
+        for (r, value) in self.trail {
             let index = r.get_value() as usize;
 
             match r.get_tag() {
-                RefTag::AttrVar | RefTag::HeapCell => self.target[index] = value,
+                RefTag::AttrVar | RefTag::HeapCell => {
+                    self.target[index] = value;
+                    self.target[index].set_mark_bit(false);
+                    self.target[index].set_forwarding_bit(false);
+                }
                 RefTag::StackCell => self.target.stack()[index] = value,
             }
         }

src/machine/dispatch.rs

@@ -208,6 +208,7 @@ impl MachineState {
                 l
             }
             (HeapCellValueTag::Fixnum |
+             HeapCellValueTag::CutPoint |
              HeapCellValueTag::Char |
              HeapCellValueTag::F64) => {
                 c
@@ -4138,6 +4139,14 @@ impl Machine {
                         try_or_throw!(self.machine_st, self.define_foreign_struct());
                         step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
                     }
+                    &Instruction::CallJsEval => {
+                        try_or_throw!(self.machine_st, self.js_eval());
+                        step_or_fail!(self, self.machine_st.p += 1);
+                    }
+                    &Instruction::ExecuteJsEval => {
+                        try_or_throw!(self.machine_st, self.js_eval());
+                        step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
+                    }
                     &Instruction::CallCurrentTime => {
                         self.current_time();
                         step_or_fail!(self, self.machine_st.p += 1);

src/machine/lib_machine.rs

@@ -57,6 +57,7 @@ impl Machine {
         or_frame.prelude.attr_var_queue_len = 0;
 
         self.machine_st.b = stub_b;
+        self.machine_st.hb = self.machine_st.heap.len();
     }
 
     pub fn run_query(&mut self, query: String) -> QueryResult {
@@ -87,6 +88,7 @@ impl Machine {
             .expect("couldn't get code index")
             .local()
             .unwrap();
+        self.machine_st.b0 = self.machine_st.b;
 
         let var_names: IndexMap<_, _> = term_write_result
             .var_dict
@@ -422,7 +424,6 @@ mod tests {
         );
     }
 
-    #[ignore = "fails on windows"]
     #[test]
     fn stress_integration_test() {
         let mut machine = Machine::new_lib();

src/machine/machine_state.rs

@@ -289,6 +289,11 @@ impl<'a> CopierTarget for CopyTerm<'a> {
         self.state.heap.push(hcv);
     }
 
+    #[inline(always)]
+    fn push_attr_var_queue(&mut self, attr_var_loc: usize) {
+        self.state.attr_var_init.attr_var_queue.push(attr_var_loc);
+    }
+
     #[inline(always)]
     fn store(&self, value: HeapCellValue) -> HeapCellValue {
         self.state.store(value)
@@ -307,6 +312,7 @@ impl<'a> CopierTarget for CopyTerm<'a> {
 
 #[derive(Debug)]
 pub(super) struct CopyBallTerm<'a> {
+    attr_var_queue: &'a mut Vec<usize>,
     stack: &'a mut Stack,
     heap: &'a mut Heap,
     heap_boundary: usize,
@@ -314,10 +320,16 @@ pub(super) struct CopyBallTerm<'a> {
 }
 
 impl<'a> CopyBallTerm<'a> {
-    pub(super) fn new(stack: &'a mut Stack, heap: &'a mut Heap, stub: &'a mut Heap) -> Self {
+    pub(super) fn new(
+        attr_var_queue: &'a mut Vec<usize>,
+        stack: &'a mut Stack,
+        heap: &'a mut Heap,
+        stub: &'a mut Heap,
+    ) -> Self {
         let hb = heap.len();
 
         CopyBallTerm {
+            attr_var_queue,
             stack,
             heap,
             heap_boundary: hb,
@@ -359,6 +371,11 @@ impl<'a> CopierTarget for CopyBallTerm<'a> {
         self.stub.push(value);
     }
 
+    #[inline(always)]
+    fn push_attr_var_queue(&mut self, attr_var_loc: usize) {
+        self.attr_var_queue.push(attr_var_loc);
+    }
+
     fn store(&self, value: HeapCellValue) -> HeapCellValue {
         read_heap_cell!(value,
             (HeapCellValueTag::Var | HeapCellValueTag::AttrVar, h) => {

src/machine/machine_state_impl.rs

@@ -334,7 +334,12 @@ impl MachineState {
         self.ball.boundary = self.heap.len();
 
         copy_term(
-            CopyBallTerm::new(&mut self.stack, &mut self.heap, &mut self.ball.stub),
+            CopyBallTerm::new(
+                &mut self.attr_var_init.attr_var_queue,
+                &mut self.stack,
+                &mut self.heap,
+                &mut self.ball.stub,
+            ),
             addr,
             AttrVarPolicy::DeepCopy,
         );

src/machine/mock_wam.rs

@@ -159,6 +159,14 @@ impl<'a> CopierTarget for TermCopyingMockWAM<'a> {
         self.wam.machine_st.heap.push(val);
     }
 
+    fn push_attr_var_queue(&mut self, attr_var_loc: usize) {
+        self.wam
+            .machine_st
+            .attr_var_init
+            .attr_var_queue
+            .push(attr_var_loc);
+    }
+
     fn stack(&mut self) -> &mut Stack {
         &mut self.wam.machine_st.stack
     }

src/machine/system_calls.rs

@@ -827,8 +827,12 @@ impl MachineState {
     ) -> usize {
         let threshold = self.lifted_heap.len() - lh_offset;
 
-        let mut copy_ball_term =
+        let mut copy_ball_term = CopyBallTerm::new(
-            CopyBallTerm::new(&mut self.stack, &mut self.heap, &mut self.lifted_heap);
+            &mut self.attr_var_init.attr_var_queue,
+            &mut self.stack,
+            &mut self.heap,
+            &mut self.lifted_heap,
+        );
 
         copy_ball_term.push(list_loc_as_cell!(threshold + 1));
         copy_ball_term.push(heap_loc_as_cell!(threshold + 3));
@@ -4878,6 +4882,70 @@ impl Machine {
         Ok(())
     }
 
+    #[cfg(not(target_arch = "wasm32"))]
+    #[inline(always)]
+    pub(crate) fn js_eval(&mut self) -> CallResult {
+        unimplemented!()
+    }
+
+    #[cfg(target_arch = "wasm32")]
+    #[inline(always)]
+    pub(crate) fn js_eval(&mut self) -> CallResult {
+        let code = self.deref_register(1);
+        let result_reg = self.deref_register(2);
+        if let Some(code) = self.machine_st.value_to_str_like(code) {
+            let result = match js_sys::eval(&code.as_str()) {
+                Ok(result) => self.unify_js_value(result, result_reg),
+                Err(result) => self.unify_js_value(result, result_reg),
+            };
+            return Ok(());
+        }
+        self.machine_st.fail = true;
+        Ok(())
+    }
+
+    #[cfg(target_arch = "wasm32")]
+    fn unify_js_value(&mut self, result: wasm_bindgen::JsValue, result_reg: HeapCellValue) {
+        match result.as_bool() {
+            Some(result) => match result {
+                true => self.machine_st.unify_atom(atom!("true"), result_reg),
+                false => self.machine_st.unify_atom(atom!("false"), result_reg),
+            },
+            None => match result.as_f64() {
+                Some(result) => {
+                    let n = float_alloc!(result, self.machine_st.arena);
+                    self.machine_st.unify_f64(n, result_reg);
+                }
+                None => match result.as_string() {
+                    Some(result) => {
+                        let result = AtomTable::build_with(&self.machine_st.atom_tbl, &result);
+                        self.machine_st.unify_complete_string(result, result_reg);
+                    }
+                    None => {
+                        if result.is_null() {
+                            self.machine_st.unify_atom(atom!("null"), result_reg);
+                        } else if result.is_undefined() {
+                            self.machine_st.unify_atom(atom!("undefined"), result_reg);
+                        } else if result.is_symbol() {
+                            self.machine_st.unify_atom(atom!("js_symbol"), result_reg);
+                        } else if result.is_object() {
+                            self.machine_st.unify_atom(atom!("js_object"), result_reg);
+                        } else if result.is_array() {
+                            self.machine_st.unify_atom(atom!("js_array"), result_reg);
+                        } else if result.is_function() {
+                            self.machine_st.unify_atom(atom!("js_function"), result_reg);
+                        } else if result.is_bigint() {
+                            self.machine_st.unify_atom(atom!("js_bigint"), result_reg);
+                        } else {
+                            self.machine_st
+                                .unify_atom(atom!("js_unknown_type"), result_reg);
+                        }
+                    }
+                },
+            },
+        }
+    }
+
     #[inline(always)]
     pub(crate) fn current_time(&mut self) {
         let timestamp = self.systemtime_to_timestamp(SystemTime::now());
@@ -6789,6 +6857,7 @@ impl Machine {
 
         copy_term(
             CopyBallTerm::new(
+                &mut self.machine_st.attr_var_init.attr_var_queue,
                 &mut self.machine_st.stack,
                 &mut self.machine_st.heap,
                 &mut ball.stub,