rishi/scryer-prolog
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge branch 'master' into flame

Browse Source
This commit is contained in:
Mark Thom
2023-11-24 18:00:55 +01:00
committed by GitHub
parent 11832b524b 1fbc7f9842
commit 4181c9fab2
17 changed files with 246 additions and 74 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
Cargo.lock generated
View File

@@ -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",

2
Cargo.toml
View File

@@ -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" }

4
build/instructions_template.rs
View File

@@ -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 |

3
src/codegen.rs
View File

@@ -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)
}
}

3
src/lib.rs
View File

@@ -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);

15
src/lib/builtins.pl
View File

@@ -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(:).

22
src/lib/iso_ext.pl
View File

@@ -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,
asserta/2,
assertz/2]).
copy_term_nat/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).

77
src/lib/time.pl
View File

@@ -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, _)),
'$cpu_now'(T0),
asserta(time_state(ID, T0)),
retract(time_state(ID, _, _)),
cputime_inferences(T0, I0),
asserta(time_state(ID, T0, I0)),
false.
report_time(ID) :-
time_state(ID, T0),
'$cpu_now'(T),
time_state(ID, T0, I0),
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
%@ true
%@ ; % CPU time: 0.001s
%@ false.
% CPU time: 0.000s, 1 inference
true
; % CPU time: 0.000s, 0 inference (exception?)
false.
:- time(use_module(library(clpz))).
%@ % CPU time: 3.711s
%@ true.
% CPU time: 0.343s, 409_874 inferences
true.
:- time(use_module(library(lists))).
%@ % CPU time: 0.006s
%@ true.
% CPU time: 0.000s, 19 inferences
true.
?- time(member(X, "abc")).
%@ % CPU time: 0.005s
%@ X = a
%@ ; % CPU time: 0.000s
%@ X = b
%@ ; % CPU time: 0.000s
%@ X = c
%@ ; % CPU time: 0.000s
%@ false.
% CPU time: 0.000s, 1 inference
X = a
; % CPU time: 0.000s, 3 inferences
X = b
; % CPU time: 0.000s, 3 inferences
X = c.
?- time((repeat,false)).
% CPU time: 2.726s, 53_330_502 inferences
error('$interrupt_thrown',repl/0).
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

29
src/lib/wasm.pl Normal file
View File

@@ -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).

32
src/machine/copier.rs
View File

@@ -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) {
for (r, value) in self.trail.drain(0..) {
fn unwind_trail(mut self) {
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,
}
}

9
src/machine/dispatch.rs
View File

@@ -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);

3
src/machine/lib_machine.rs
View File

@@ -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();

19
src/machine/machine_state.rs
View File

@@ -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) => {

7
src/machine/machine_state_impl.rs
View File

@@ -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,
);

8
src/machine/mock_wam.rs
View File

@@ -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
}

73
src/machine/system_calls.rs
View File

@@ -827,8 +827,12 @@ impl MachineState {
) -> usize {
let threshold = self.lifted_heap.len() - lh_offset;
let mut copy_ball_term =
CopyBallTerm::new(&mut self.stack, &mut self.heap, &mut self.lifted_heap);
let mut copy_ball_term = CopyBallTerm::new(
&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,

2
src/toplevel.pl
View File

@@ -452,4 +452,4 @@ print_exception_with_check(E) :-
% is expected to be printed instead.
; print_exception(E)
).