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

Merge pull request #1635 from mthom/rebis-dev

Browse Source 
Merge rebis-dev into master
This commit is contained in:
Mark Thom
2022-11-10 07:18:10 +01:00
committed by GitHub
parent c7e1f5d568 694c87cb61
commit 1c7a6b2b28
63 changed files with 5194 additions and 2563 deletions
Download Patch File Download Diff File Expand all files Collapse all files

17
.github/workflows/test.yml vendored
View File

@@ -52,3 +52,20 @@ jobs:
crate: cargo-msrv
- name: Verify MSRV
run: cargo msrv --verify
windows:
runs-on: windows-latest
defaults:
run:
shell: msys2 {0}
steps:
- name: Setup MSYS2
uses: msys2/setup-msys2@v2
with:
update: true
install: >-
base-devel
mingw-w64-x86_64-rust
- name: Checkout sources
uses: actions/checkout@v3
- name: Test on Windows
run: cargo test --verbose --all

980
Cargo.lock generated
View File

File diff suppressed because it is too large Load Diff

15
Cargo.toml
View File

@@ -1,6 +1,6 @@
[package]
name = "scryer-prolog"
version = "0.9.0"
version = "0.9.1"
authors = ["Mark Thom <markjordanthom@gmail.com>"]
edition = "2021"
description = "A modern Prolog implementation written mostly in Rust."
@@ -10,13 +10,9 @@ license = "BSD-3-Clause"
keywords = ["prolog", "prolog-interpreter", "prolog-system"]
categories = ["command-line-utilities"]
build = "build/main.rs"
rust-version = "1.57"
rust-version = "1.61"
[features]
num = ["num-rug-adapter"]
# no default features to make num tests work
# workaround for --no-default-features and --features not working intuitively for workspaces with a root package
# see rust-lang/cargo#7160
default = ["rug"]
[build-dependencies]
@@ -44,7 +40,6 @@ lexical = "5.2.2"
libc = "0.2.62"
modular-bitfield = "0.11.2"
ctrlc = "3.2.2"
num-rug-adapter = { version = "0.1.6", optional = true }
ordered-float = "2.6.0"
phf = { version = "0.9", features = ["macros"] }
ref_thread_local = "0.0.0"
@@ -54,7 +49,7 @@ ring = "0.16.13"
ripemd160 = "0.8.0"
sha3 = "0.8.2"
blake2 = "0.8.1"
openssl = { version = "0.10.29", features = ["vendored"] }
crrl ="0.2.0"
native-tls = "0.2.4"
chrono = "0.4.11"
select = "0.4.3"
@@ -67,6 +62,7 @@ ryu = "1.0.9"
hyper = { version = "0.14", features = ["full"] }
hyper-tls = "0.5.0"
tokio = { version = "1", features = ["full"] }
futures = "0.3"
[dev-dependencies]
assert_cmd = "1.0.3"
@@ -75,7 +71,6 @@ serial_test = "0.5.1"
[patch.crates-io]
modular-bitfield = { git = "https://github.com/mthom/modular-bitfield" }
num-rug-adapter = { git = "https://github.com/mthom/num-rug-adapter" }
[profile.release]
debug = true
debug = true

2
README.md
View File

@@ -539,7 +539,7 @@ The modules that ship with Scryer&nbsp;Prolog are also called
Probabilistic predicates and random number generators.
* [`http/http_open`](src/lib/http/http_open.pl) Open a stream to
read answers from web&nbsp;servers. HTTPS is also supported.
* [`http/http_server`](src/lib/http/http_server.pl) Runs a HTTP/1.0 web server.
* [`http/http_server`](src/lib/http/http_server.pl) Runs a HTTP/1.1 and HTTP/2.0 web server. Uses [Hyper](https://hyper.rs) as a backend. Supports some query and form handling.
* [`sgml`](src/lib/sgml.pl)
`load_html/3` and `load_xml/3` represent HTML and XML&nbsp;documents
as Prolog&nbsp;terms for convenient and efficient reasoning. Use

131
build/instructions_template.rs
View File

@@ -190,9 +190,9 @@ enum REPLCodePtr {
DynamicProperty,
#[strum_discriminants(strum(props(Arity = "3", Name = "$abolish_clause")))]
AbolishClause,
#[strum_discriminants(strum(props(Arity = "5", Name = "$asserta")))]
#[strum_discriminants(strum(props(Arity = "3", Name = "$asserta")))]
Asserta,
#[strum_discriminants(strum(props(Arity = "5", Name = "$assertz")))]
#[strum_discriminants(strum(props(Arity = "3", Name = "$assertz")))]
Assertz,
#[strum_discriminants(strum(props(Arity = "4", Name = "$retract_clause")))]
Retract,
@@ -404,8 +404,6 @@ enum SystemClauseType {
InferenceLevel,
#[strum_discriminants(strum(props(Arity = "1", Name = "$clean_up_block")))]
CleanUpBlock,
#[strum_discriminants(strum(props(Arity = "0", Name = "$erase_ball")))]
EraseBall,
#[strum_discriminants(strum(props(Arity = "0", Name = "$fail")))]
Fail,
#[strum_discriminants(strum(props(Arity = "1", Name = "$get_ball")))]
@@ -434,6 +432,12 @@ enum SystemClauseType {
ReturnFromVerifyAttr,
#[strum_discriminants(strum(props(Arity = "1", Name = "$set_ball")))]
SetBall,
#[strum_discriminants(strum(props(Arity = "0", Name = "$push_ball_stack")))]
PushBallStack,
#[strum_discriminants(strum(props(Arity = "0", Name = "$pop_ball_stack")))]
PopBallStack,
#[strum_discriminants(strum(props(Arity = "0", Name = "$pop_from_ball_stack")))]
PopFromBallStack,
#[strum_discriminants(strum(props(Arity = "1", Name = "$set_cp_by_default")))]
SetCutPointByDefault(RegType),
#[strum_discriminants(strum(props(Arity = "1", Name = "$set_double_quotes")))]
@@ -492,7 +496,7 @@ enum SystemClauseType {
CryptoDataEncrypt,
#[strum_discriminants(strum(props(Arity = "6", Name = "$crypto_data_decrypt")))]
CryptoDataDecrypt,
#[strum_discriminants(strum(props(Arity = "5", Name = "$crypto_curve_scalar_mult")))]
#[strum_discriminants(strum(props(Arity = "4", Name = "$crypto_curve_scalar_mult")))]
CryptoCurveScalarMult,
#[strum_discriminants(strum(props(Arity = "4", Name = "$ed25519_sign")))]
Ed25519Sign,
@@ -544,10 +548,22 @@ enum SystemClauseType {
DeterministicLengthRundown,
#[strum_discriminants(strum(props(Arity = "7", Name = "$http_open")))]
HttpOpen,
#[strum_discriminants(strum(props(Arity = "2", Name = "$http_listen")))]
HttpListen,
#[strum_discriminants(strum(props(Arity = "7", Name = "$http_accept")))]
HttpAccept,
#[strum_discriminants(strum(props(Arity = "4", Name = "$http_answer")))]
HttpAnswer,
#[strum_discriminants(strum(props(Arity = "3", Name = "$predicate_defined")))]
PredicateDefined,
#[strum_discriminants(strum(props(Arity = "3", Name = "$strip_module")))]
StripModule,
#[strum_discriminants(strum(props(Arity = "4", Name = "$compile_inline_or_expanded_goal")))]
CompileInlineOrExpandedGoal,
#[strum_discriminants(strum(props(Arity = "arity", Name = "$call_inline")))]
InlineCallN(usize),
#[strum_discriminants(strum(props(Arity = "1", Name = "$is_expanded_or_inlined")))]
IsExpandedOrInlined,
REPL(REPLCodePtr),
}
@@ -1435,6 +1451,12 @@ fn generate_instruction_preface() -> TokenStream {
&Instruction::DefaultExecuteN(arity, _) => {
functor!(atom!("execute_default_n"), [fixnum(arity)])
}
&Instruction::CallInlineCallN(arity, _) => {
functor!(atom!("call_n_inline"), [fixnum(arity)])
}
&Instruction::ExecuteInlineCallN(arity, _) => {
functor!(atom!("call_n_inline"), [fixnum(arity)])
}
&Instruction::CallTermGreaterThan(_) |
&Instruction::CallTermLessThan(_) |
&Instruction::CallTermGreaterThanOrEqual(_) |
@@ -1597,6 +1619,8 @@ fn generate_instruction_preface() -> TokenStream {
&Instruction::CallDeleteHeadAttribute(_) |
&Instruction::CallDynamicModuleResolution(..) |
&Instruction::CallPrepareCallClause(..) |
&Instruction::CallCompileInlineOrExpandedGoal(..) |
&Instruction::CallIsExpandedOrInlined(_) |
&Instruction::CallEnqueueAttributedVar(_) |
&Instruction::CallFetchGlobalVar(_) |
&Instruction::CallFirstStream(_) |
@@ -1660,7 +1684,6 @@ fn generate_instruction_preface() -> TokenStream {
&Instruction::CallSetStreamPosition(_) |
&Instruction::CallInferenceLevel(_) |
&Instruction::CallCleanUpBlock(_) |
&Instruction::CallEraseBall(_) |
&Instruction::CallFail(_) |
&Instruction::CallGetBall(_) |
&Instruction::CallGetCurrentBlock(_) |
@@ -1672,6 +1695,9 @@ fn generate_instruction_preface() -> TokenStream {
&Instruction::CallCpuNow(_) |
&Instruction::CallDeterministicLengthRundown(_) |
&Instruction::CallHttpOpen(_) |
&Instruction::CallHttpListen(_) |
&Instruction::CallHttpAccept(_) |
&Instruction::CallHttpAnswer(_) |
&Instruction::CallPredicateDefined(_) |
&Instruction::CallStripModule(_) |
&Instruction::CallCurrentTime(_) |
@@ -1680,6 +1706,9 @@ fn generate_instruction_preface() -> TokenStream {
&Instruction::CallResetBlock(_) |
&Instruction::CallReturnFromVerifyAttr(_) |
&Instruction::CallSetBall(_) |
&Instruction::CallPushBallStack(_) |
&Instruction::CallPopBallStack(_) |
&Instruction::CallPopFromBallStack(_) |
&Instruction::CallSetCutPointByDefault(..) |
&Instruction::CallSetDoubleQuotes(_) |
&Instruction::CallSetSeed(_) |
@@ -1804,6 +1833,8 @@ fn generate_instruction_preface() -> TokenStream {
&Instruction::ExecuteDeleteHeadAttribute(_) |
&Instruction::ExecuteDynamicModuleResolution(..) |
&Instruction::ExecutePrepareCallClause(..) |
&Instruction::ExecuteCompileInlineOrExpandedGoal(..) |
&Instruction::ExecuteIsExpandedOrInlined(_) |
&Instruction::ExecuteEnqueueAttributedVar(_) |
&Instruction::ExecuteFetchGlobalVar(_) |
&Instruction::ExecuteFirstStream(_) |
@@ -1867,7 +1898,6 @@ fn generate_instruction_preface() -> TokenStream {
&Instruction::ExecuteSetStreamPosition(_) |
&Instruction::ExecuteInferenceLevel(_) |
&Instruction::ExecuteCleanUpBlock(_) |
&Instruction::ExecuteEraseBall(_) |
&Instruction::ExecuteFail(_) |
&Instruction::ExecuteGetBall(_) |
&Instruction::ExecuteGetCurrentBlock(_) |
@@ -1879,6 +1909,9 @@ fn generate_instruction_preface() -> TokenStream {
&Instruction::ExecuteCpuNow(_) |
&Instruction::ExecuteDeterministicLengthRundown(_) |
&Instruction::ExecuteHttpOpen(_) |
&Instruction::ExecuteHttpListen(_) |
&Instruction::ExecuteHttpAccept(_) |
&Instruction::ExecuteHttpAnswer(_) |
&Instruction::ExecutePredicateDefined(_) |
&Instruction::ExecuteStripModule(_) |
&Instruction::ExecuteCurrentTime(_) |
@@ -1887,6 +1920,9 @@ fn generate_instruction_preface() -> TokenStream {
&Instruction::ExecuteResetBlock(_) |
&Instruction::ExecuteReturnFromVerifyAttr(_) |
&Instruction::ExecuteSetBall(_) |
&Instruction::ExecutePushBallStack(_) |
&Instruction::ExecutePopBallStack(_) |
&Instruction::ExecutePopFromBallStack(_) |
&Instruction::ExecuteSetCutPointByDefault(_, _) |
&Instruction::ExecuteSetDoubleQuotes(_) |
&Instruction::ExecuteSetSeed(_) |
@@ -2179,6 +2215,7 @@ pub fn generate_instructions_rs() -> TokenStream {
let mut clause_type_from_name_and_arity_arms = vec![];
let mut clause_type_to_instr_arms = vec![];
let mut clause_type_name_arms = vec![];
let mut is_inbuilt_arms = vec![];
for (name, arity, variant) in instr_data.compare_number_variants {
let ident = variant.ident.clone();
@@ -2233,6 +2270,12 @@ pub fn generate_instructions_rs() -> TokenStream {
) => Instruction::#instr_ident(#(#placeholder_ids),*, 0)
}
);
is_inbuilt_arms.push(
quote! {
(atom!(#name), #arity) => true
}
);
}
for (name, arity, variant) in instr_data.compare_term_variants {
@@ -2262,6 +2305,12 @@ pub fn generate_instructions_rs() -> TokenStream {
) => Instruction::#instr_ident(0)
}
);
is_inbuilt_arms.push(
quote! {
(atom!(#name), #arity) => true
}
);
}
for (name, arity, variant) in instr_data.builtin_type_variants {
@@ -2323,6 +2372,12 @@ pub fn generate_instructions_rs() -> TokenStream {
) => Instruction::#instr_ident(0)
}
});
is_inbuilt_arms.push(
quote! {
(atom!(#name), #arity) => true
}
);
}
for (name, arity, variant) in instr_data.inlined_type_variants {
@@ -2382,6 +2437,12 @@ pub fn generate_instructions_rs() -> TokenStream {
) => Instruction::#instr_ident(#(#placeholder_ids),*,0)
}
);
is_inbuilt_arms.push(
quote! {
(atom!(#name), #arity) => true
}
);
}
for (name, arity, variant) in instr_data.system_clause_type_variants {
@@ -2412,6 +2473,12 @@ pub fn generate_instructions_rs() -> TokenStream {
SystemClauseType::#ident(temp_v!(1))
)
}
} else if ident.to_string() == "InlineCallN" {
quote! {
(atom!(#name), arity) => ClauseType::System(
SystemClauseType::#ident(arity)
)
}
} else {
quote! {
(atom!(#name), #arity) => ClauseType::System(
@@ -2442,6 +2509,7 @@ pub fn generate_instructions_rs() -> TokenStream {
});
let ident = variant.ident;
let instr_ident = if ident != "CallContinuation" {
format_ident!("Call{}", ident)
} else {
@@ -2465,6 +2533,18 @@ pub fn generate_instructions_rs() -> TokenStream {
) => Instruction::#instr_ident(0)
}
});
is_inbuilt_arms.push(
if let Arity::Ident("arity") = &arity {
quote! {
(atom!(#name), _arity) => true
}
} else {
quote! {
(atom!(#name), #arity) => true
}
}
);
}
for (name, arity, variant) in instr_data.repl_code_ptr_variants {
@@ -2530,6 +2610,12 @@ pub fn generate_instructions_rs() -> TokenStream {
)) => Instruction::#instr_ident(0)
}
});
is_inbuilt_arms.push(
quote! {
(atom!(#name), #arity) => true
}
);
}
for (name, arity, variant) in instr_data.clause_type_variants {
@@ -2537,7 +2623,7 @@ pub fn generate_instructions_rs() -> TokenStream {
if ident == "Named" {
clause_type_from_name_and_arity_arms.push(quote! {
(name, arity) => ClauseType::Named(arity, name, CodeIndex::default())
(name, arity) => ClauseType::Named(arity, name, CodeIndex::default(arena))
});
clause_type_to_instr_arms.push(quote! {
@@ -2599,6 +2685,12 @@ pub fn generate_instructions_rs() -> TokenStream {
ClauseType::#ident => Instruction::#ident(0)
}
});
is_inbuilt_arms.push(
quote! {
(atom!(#name), _arity) => true
}
);
}
let to_execute_arms: Vec<_> = instr_data.instr_variants
@@ -2933,7 +3025,7 @@ pub fn generate_instructions_rs() -> TokenStream {
}
impl ClauseType {
pub fn from(name: Atom, arity: usize) -> ClauseType {
pub fn from(name: Atom, arity: usize, arena: &mut Arena) -> ClauseType {
match (name, arity) {
#(
#clause_type_from_name_and_arity_arms,
@@ -2949,19 +3041,12 @@ pub fn generate_instructions_rs() -> TokenStream {
}
}
pub fn is_builtin(&self) -> bool {
if let ClauseType::BuiltIn(_) = self {
true
} else {
false
}
}
pub fn is_inlined(&self) -> bool {
if let ClauseType::Inlined(_) = self {
true
} else {
false
pub fn is_inbuilt(name: Atom, arity: usize) -> bool {
match (name, arity) {
#(
#is_inbuilt_arms,
)*
_ => false,
}
}
@@ -3156,7 +3241,7 @@ enum Arity {
impl From<&'static str> for Arity {
fn from(arity: &'static str) -> Self {
usize::from_str_radix(&arity, 10)
.map(|n| Arity::Static(n))
.map(Arity::Static)
.unwrap_or_else(|_| Arity::Ident(arity))
}
}

2
build/static_string_indexing.rs
View File

@@ -66,7 +66,7 @@ impl<'ast> Visit<'ast> for StaticStrVisitor {
if let Some(Lit::Str(string)) = m.parse_body::<Lit>().ok() {
self.static_strs.insert(string.value());
}
} else if path.is_ident("read_heap_cell") {
} else if path.is_ident("read_heap_cell") || path.is_ident("match_untyped_arena_ptr") {
if let Some(m) = m.parse_body::<ReadHeapCellExprAndArms>().ok() {
self.visit_expr(&m.expr);

174
src/arena.rs
View File

@@ -1,10 +1,10 @@
use crate::http::{HttpListener, HttpResponse};
use crate::machine::loader::LiveLoadState;
use crate::machine::machine_indices::*;
use crate::machine::streams::*;
use crate::raw_block::*;
use crate::read::*;
use modular_bitfield::prelude::*;
use ordered_float::OrderedFloat;
use crate::parser::rug::{Integer, Rational};
@@ -21,7 +21,7 @@ macro_rules! arena_alloc {
($e:expr, $arena:expr) => {{
let result = $e;
#[allow(unused_unsafe)]
unsafe { $arena.alloc(result) }
unsafe { ArenaAllocated::alloc($arena, result) }
}};
}
@@ -140,7 +140,8 @@ pub enum ArenaHeaderTag {
OutputFileStream = 0b10100,
NamedTcpStream = 0b011100,
NamedTlsStream = 0b100000,
NamedHttpClientStream = 0b100001,
HttpReadStream = 0b100001,
HttpWriteStream = 0b100010,
ReadlineStream = 0b110000,
StaticStringStream = 0b110100,
ByteStream = 0b111000,
@@ -148,7 +149,13 @@ pub enum ArenaHeaderTag {
StandardErrorStream = 0b11000,
NullStream = 0b111100,
TcpListener = 0b1000000,
HttpListener = 0b1000001,
HttpResponse = 0b1000010,
Dropped = 0b1000100,
IndexPtrDynamicUndefined = 0b1000101,
IndexPtrDynamicIndex = 0b1000110,
IndexPtrIndex = 0b1000111,
IndexPtrUndefined = 0b1001000,
}
#[bitfield]
@@ -234,7 +241,7 @@ impl<T: fmt::Display> fmt::Display for TypedArenaPtr<T> {
}
}
impl<T: ?Sized> TypedArenaPtr<T> {
impl<T: ?Sized + ArenaAllocated> TypedArenaPtr<T> {
#[inline]
pub const fn new(data: *mut T) -> Self {
unsafe { TypedArenaPtr(ptr::NonNull::new_unchecked(data)) }
@@ -248,14 +255,14 @@ impl<T: ?Sized> TypedArenaPtr<T> {
#[inline]
pub fn header_ptr(&self) -> *const ArenaHeader {
let mut ptr = self.as_ptr() as *const u8 as usize;
ptr -= mem::size_of::<*const ArenaHeader>();
ptr -= T::header_offset_from_payload(); // mem::size_of::<*const ArenaHeader>();
ptr as *const ArenaHeader
}
#[inline]
fn header_ptr_mut(&mut self) -> *mut ArenaHeader {
let mut ptr = self.as_ptr() as *const u8 as usize;
ptr -= mem::size_of::<*const ArenaHeader>();
ptr -= T::header_offset_from_payload(); // mem::size_of::<*const ArenaHeader>();
ptr as *mut ArenaHeader
}
@@ -289,14 +296,35 @@ impl<T: ?Sized> TypedArenaPtr<T> {
}
}
pub trait ArenaAllocated {
pub trait ArenaAllocated: Sized {
type PtrToAllocated;
fn tag() -> ArenaHeaderTag;
fn size(&self) -> usize;
fn copy_to_arena(self, dst: *mut Self) -> Self::PtrToAllocated
where
Self: Sized;
fn copy_to_arena(self, dst: *mut Self) -> Self::PtrToAllocated;
fn header_offset_from_payload() -> usize {
mem::size_of::<*const ArenaHeader>()
}
unsafe fn alloc(arena: &mut Arena, value: Self) -> Self::PtrToAllocated {
let size = value.size() + mem::size_of::<AllocSlab>();
let align = mem::align_of::<AllocSlab>();
let layout = alloc::Layout::from_size_align_unchecked(size, align);
let slab = alloc::alloc(layout) as *mut AllocSlab;
(*slab).next = arena.base;
(*slab).header = ArenaHeader::build_with(value.size() as u64, Self::tag());
let offset = (*slab).payload_offset();
let result = value.copy_to_arena(offset as *mut Self);
arena.base = slab;
result
}
}
#[derive(Copy, Clone, Debug)]
@@ -536,6 +564,93 @@ impl ArenaAllocated for TcpListener {
}
}
impl ArenaAllocated for HttpListener {
type PtrToAllocated = TypedArenaPtr<HttpListener>;
#[inline]
fn tag() -> ArenaHeaderTag {
ArenaHeaderTag::HttpListener
}
#[inline]
fn size(&self) -> usize {
mem::size_of::<Self>()
}
#[inline]
fn copy_to_arena(self, dst: *mut Self) -> Self::PtrToAllocated {
unsafe {
ptr::write(dst, self);
TypedArenaPtr::new(dst as *mut Self)
}
}
}
impl ArenaAllocated for HttpResponse {
type PtrToAllocated = TypedArenaPtr<HttpResponse>;
#[inline]
fn tag() -> ArenaHeaderTag {
ArenaHeaderTag::HttpResponse
}
#[inline]
fn size(&self) -> usize {
mem::size_of::<Self>()
}
#[inline]
fn copy_to_arena(self, dst: *mut Self) -> Self::PtrToAllocated {
unsafe {
ptr::write(dst, self);
TypedArenaPtr::new(dst as *mut Self)
}
}
}
impl ArenaAllocated for IndexPtr {
type PtrToAllocated = TypedArenaPtr<IndexPtr>;
#[inline]
fn tag() -> ArenaHeaderTag {
ArenaHeaderTag::IndexPtrUndefined
}
#[inline]
fn size(&self) -> usize {
mem::size_of::<Self>()
}
#[inline]
fn copy_to_arena(self, dst: *mut Self) -> Self::PtrToAllocated {
unsafe {
ptr::write(dst, self);
TypedArenaPtr::new(dst as *mut Self)
}
}
#[inline]
fn header_offset_from_payload() -> usize {
0
}
unsafe fn alloc(arena: &mut Arena, value: Self) -> Self::PtrToAllocated {
let size = mem::size_of::<AllocSlab>();
let align = mem::align_of::<AllocSlab>();
let layout = alloc::Layout::from_size_align_unchecked(size, align);
let slab = alloc::alloc(layout) as *mut AllocSlab;
(*slab).next = arena.base;
let result = value.copy_to_arena(mem::transmute::<_, *mut IndexPtr>(&(*slab).header));
arena.base = slab;
result
}
}
#[derive(Clone, Copy, Debug)]
struct AllocSlab {
next: *mut AllocSlab,
@@ -556,25 +671,6 @@ impl Arena {
pub fn new() -> Self {
Arena { base: ptr::null_mut(), f64_tbl: F64Table::new() }
}
pub unsafe fn alloc<T: ArenaAllocated>(&mut self, value: T) -> T::PtrToAllocated {
let size = value.size() + mem::size_of::<AllocSlab>();
let align = mem::align_of::<AllocSlab>();
let layout = alloc::Layout::from_size_align_unchecked(size, align);
let slab = alloc::alloc(layout) as *mut AllocSlab;
(*slab).next = self.base;
(*slab).header = ArenaHeader::build_with(value.size() as u64, T::tag());
let offset = (*slab).payload_offset();
let result = value.copy_to_arena(offset as *mut T);
self.base = slab;
result
}
}
unsafe fn drop_slab_in_place(value: &mut AllocSlab) {
@@ -599,9 +695,12 @@ unsafe fn drop_slab_in_place(value: &mut AllocSlab) {
ArenaHeaderTag::NamedTlsStream => {
ptr::drop_in_place(value.payload_offset::<StreamLayout<CharReader<NamedTlsStream>>>());
}
ArenaHeaderTag::NamedHttpClientStream => {
ptr::drop_in_place(value.payload_offset::<StreamLayout<CharReader<NamedHttpClientStream>>>());
ArenaHeaderTag::HttpReadStream => {
ptr::drop_in_place(value.payload_offset::<StreamLayout<CharReader<HttpReadStream>>>());
}
ArenaHeaderTag::HttpWriteStream => {
ptr::drop_in_place(value.payload_offset::<StreamLayout<CharReader<HttpWriteStream>>>());
}
ArenaHeaderTag::ReadlineStream => {
ptr::drop_in_place(value.payload_offset::<StreamLayout<ReadlineStream>>());
}
@@ -622,13 +721,21 @@ unsafe fn drop_slab_in_place(value: &mut AllocSlab) {
ArenaHeaderTag::TcpListener => {
ptr::drop_in_place(value.payload_offset::<TcpListener>());
}
ArenaHeaderTag::HttpListener => {
ptr::drop_in_place(value.payload_offset::<HttpListener>());
}
ArenaHeaderTag::HttpResponse => {
ptr::drop_in_place(value.payload_offset::<HttpResponse>());
}
ArenaHeaderTag::StandardOutputStream => {
ptr::drop_in_place(value.payload_offset::<StreamLayout<StandardOutputStream>>());
}
ArenaHeaderTag::StandardErrorStream => {
ptr::drop_in_place(value.payload_offset::<StreamLayout<StandardErrorStream>>());
}
ArenaHeaderTag::NullStream => {
ArenaHeaderTag::NullStream | ArenaHeaderTag::IndexPtrUndefined |
ArenaHeaderTag::IndexPtrDynamicUndefined | ArenaHeaderTag::IndexPtrDynamicIndex |
ArenaHeaderTag::IndexPtrIndex => {
}
}
}
@@ -745,7 +852,8 @@ mod tests {
// integer
let big_int: Integer = 2 * Integer::from(1u64 << 63);
let big_int_ptr: TypedArenaPtr<Integer> = arena_alloc!(big_int, wam.machine_st.arena);
let big_int_ptr: TypedArenaPtr<Integer> =
arena_alloc!(big_int, &mut wam.machine_st.arena);
assert!(!big_int_ptr.as_ptr().is_null());

18
src/arithmetic.rs
View File

@@ -13,7 +13,6 @@ use crate::parser::rug::ops::PowAssign;
use crate::parser::rug::{Assign, Integer, Rational};
use crate::machine::machine_errors::*;
use crate::machine::machine_indices::*;
use ordered_float::*;
@@ -65,19 +64,22 @@ impl<'a> ArithInstructionIterator<'a> {
fn from(term: &'a Term) -> Result<Self, ArithmeticError> {
let state = match term {
Term::AnonVar => return Err(ArithmeticError::UninstantiatedVar),
Term::Clause(cell, name, terms) => match ClauseType::from(*name, terms.len()) {
Term::Clause(cell, name, terms) => {
TermIterState::Clause(Level::Shallow, 0, cell, *name, terms)
}
/* match ClauseType::from(*name, terms.len()) {
ct @ ClauseType::Named(..) => {
Ok(TermIterState::Clause(Level::Shallow, 0, cell, ct, terms))
}
ClauseType::Inlined(InlinedClauseType::IsFloat(_)) => {
let ct = ClauseType::Named(1, atom!("float"), CodeIndex::default());
ct @ ClauseType::Inlined(InlinedClauseType::IsFloat(_)) => {
// let ct = ClauseType::Named(1, atom!("float"), CodeIndex::default());
Ok(TermIterState::Clause(Level::Shallow, 0, cell, ct, terms))
}
_ => Err(ArithmeticError::NonEvaluableFunctor(
Literal::Atom(*name),
terms.len(),
)),
}?,
}?,*/
Term::Literal(cell, cons) => TermIterState::Literal(Level::Shallow, cell, cons),
Term::Cons(..) | Term::PartialString(..) | Term::CompleteString(..) => {
return Err(ArithmeticError::NonEvaluableFunctor(
@@ -108,17 +110,17 @@ impl<'a> Iterator for ArithInstructionIterator<'a> {
while let Some(iter_state) = self.state_stack.pop() {
match iter_state {
TermIterState::AnonVar(_) => return Some(Err(ArithmeticError::UninstantiatedVar)),
TermIterState::Clause(lvl, child_num, cell, ct, subterms) => {
TermIterState::Clause(lvl, child_num, cell, name, subterms) => {
let arity = subterms.len();
if child_num == arity {
return Some(Ok(ArithTermRef::Op(ct.name(), arity)));
return Some(Ok(ArithTermRef::Op(name, arity)));
} else {
self.state_stack.push(TermIterState::Clause(
lvl,
child_num + 1,
cell,
ct,
name,
subterms,
));

36
src/codegen.rs
View File

@@ -263,6 +263,27 @@ impl DebrayAllocator {
}
}
// if the final argument of the structure is a Literal::Index,
// decrement the arity of the PutStructure instruction by 1.
fn trim_structure_by_last_arg(instr: &mut Instruction, last_arg: &Term) {
match instr {
Instruction::PutStructure(_, ref mut arity, _) |
Instruction::GetStructure(_, ref mut arity, _) => {
if let Term::Literal(_, Literal::CodeIndex(_)) = last_arg {
// it is acceptable if arity == 0 is the result of
// this decrement. call/N will have to read the index
// constant for '$call_inline' to succeed. to find it,
// it must know the heap location of the index.
// self.store must stop before reading the atom into a
// register.
*arity -= 1;
}
}
_ => {}
}
}
impl<'b> CodeGenerator<'b> {
pub(crate) fn new(atom_tbl: &'b mut AtomTable, settings: CodeGenSettings) -> Self {
CodeGenerator {
@@ -369,9 +390,15 @@ impl<'b> CodeGenerator<'b> {
self.marker.mark_anon_var::<Target>(lvl, term_loc, &mut target);
}
}
TermRef::Clause(lvl, cell, ct, terms) => {
TermRef::Clause(lvl, cell, name, terms) => {
self.marker.mark_non_var::<Target>(lvl, term_loc, cell, &mut target);
target.push(Target::to_structure(ct.name(), terms.len(), cell.get()));
target.push(Target::to_structure(name, terms.len(), cell.get()));
if let Some(instr) = target.last_mut() {
if let Some(term) = terms.last() {
trim_structure_by_last_arg(instr, term);
}
}
for subterm in terms {
self.subterm_to_instr::<Target>(subterm, term_loc, is_exposed, &mut target);
@@ -1039,10 +1066,7 @@ impl<'b> CodeGenerator<'b> {
let iter = query_term_post_order_iter(term);
let query = self.compile_target::<QueryInstruction, _>(iter, term_loc, is_exposed);
if !query.is_empty() {
code.extend(query.into_iter());
}
code.extend(query.into_iter());
self.add_conditional_call(code, term, num_perm_vars_left);
}

11
src/forms.rs
View File

@@ -154,24 +154,21 @@ impl ClauseInfo for PredicateKey {
impl ClauseInfo for Term {
fn name(&self) -> Option<Atom> {
//, atom_tbl: &AtomTable) -> Option<StringBuffer> {
match self {
Term::Clause(_, name, terms) => {
// let str_buf = StringBuffer::from(*name, atom_tbl);
match name.as_str() {
// str_buf.as_str() {
":-" => {
match name {
atom!(":-") => {
match terms.len() {
1 => None, // a declaration.
2 => terms[0].name(), //.map(|name| StringBuffer::from(name, atom_tbl)),
2 => terms[0].name(),
_ => Some(*name),
}
}
_ => Some(*name), //str_buf),
}
}
Term::Literal(_, Literal::Atom(name)) => Some(*name), //Some(StringBuffer::from(*name, atom_tbl)),
Term::Literal(_, Literal::Atom(name)) => Some(*name),
_ => None,
}
}

72
src/heap_iter.rs
View File

@@ -89,6 +89,17 @@ impl<'a> Drop for StackfulPreOrderHeapIter<'a> {
}
}
pub trait FocusedHeapIter: Iterator<Item = HeapCellValue> {
fn focus(&self) -> usize;
}
impl<'a> FocusedHeapIter for StackfulPreOrderHeapIter<'a> {
#[inline]
fn focus(&self) -> usize {
self.h
}
}
impl<'a> StackfulPreOrderHeapIter<'a> {
#[inline]
fn new(heap: &'a mut Vec<HeapCellValue>, cell: HeapCellValue) -> Self {
@@ -126,11 +137,6 @@ impl<'a> StackfulPreOrderHeapIter<'a> {
None
}
#[inline]
pub fn focus(&self) -> usize {
self.h
}
#[inline]
pub fn pop_stack(&mut self) -> Option<HeapCellValue> {
while let Some(h) = self.stack.pop() {
@@ -271,13 +277,14 @@ pub(crate) fn stackful_preorder_iter(
}
#[derive(Debug)]
pub(crate) struct PostOrderIterator<Iter: Iterator<Item = HeapCellValue>> {
pub(crate) struct PostOrderIterator<Iter: FocusedHeapIter> {
focus: usize,
base_iter: Iter,
base_iter_valid: bool,
parent_stack: Vec<(usize, HeapCellValue)>, // number of children, parent node.
parent_stack: Vec<(usize, HeapCellValue, usize)>, // number of children, parent node, focus.
}
impl<Iter: Iterator<Item = HeapCellValue>> Deref for PostOrderIterator<Iter> {
impl<Iter: FocusedHeapIter> Deref for PostOrderIterator<Iter> {
type Target = Iter;
fn deref(&self) -> &Self::Target {
@@ -285,9 +292,10 @@ impl<Iter: Iterator<Item = HeapCellValue>> Deref for PostOrderIterator<Iter> {
}
}
impl<Iter: Iterator<Item = HeapCellValue>> PostOrderIterator<Iter> {
impl<Iter: FocusedHeapIter> PostOrderIterator<Iter> {
pub(crate) fn new(base_iter: Iter) -> Self {
PostOrderIterator {
focus: 0,
base_iter,
base_iter_valid: true,
parent_stack: vec![],
@@ -295,32 +303,36 @@ impl<Iter: Iterator<Item = HeapCellValue>> PostOrderIterator<Iter> {
}
}
impl<Iter: Iterator<Item = HeapCellValue>> Iterator for PostOrderIterator<Iter> {
impl<Iter: FocusedHeapIter> Iterator for PostOrderIterator<Iter> {
type Item = HeapCellValue;
fn next(&mut self) -> Option<Self::Item> {
loop {
if let Some((child_count, node)) = self.parent_stack.pop() {
if let Some((child_count, node, focus)) = self.parent_stack.pop() {
if child_count == 0 {
self.focus = focus;
return Some(node);
}
self.parent_stack.push((child_count - 1, node));
self.parent_stack.push((child_count - 1, node, focus));
}
if self.base_iter_valid {
if let Some(item) = self.base_iter.next() {
let focus = self.base_iter.focus();
read_heap_cell!(item,
(HeapCellValueTag::Atom, (_name, arity)) => {
self.parent_stack.push((arity, item));
self.parent_stack.push((arity, item, focus));
}
(HeapCellValueTag::Lis) => {
self.parent_stack.push((2, item));
self.parent_stack.push((2, item, focus));
}
(HeapCellValueTag::PStr | HeapCellValueTag::PStrOffset) => {
self.parent_stack.push((1, item));
self.parent_stack.push((1, item, focus));
}
_ => {
self.focus = focus;
return Some(item);
}
);
@@ -338,12 +350,40 @@ impl<Iter: Iterator<Item = HeapCellValue>> Iterator for PostOrderIterator<Iter>
}
}
impl<Iter: FocusedHeapIter> FocusedHeapIter for PostOrderIterator<Iter> {
#[inline(always)]
fn focus(&self) -> usize {
self.focus
}
}
impl<Iter: FocusedHeapIter> PostOrderIterator<Iter> {
/* return true if the term at heap offset idx_loc is a
* direct/inlined subterm of a structure at the focus of
* self.stack.last(). this function is used to determine, e.g.,
* ownership of inlined code indices.
*/
#[inline]
pub(crate) fn direct_subterm_of_str(&self, idx_loc: usize) -> bool {
if let Some((_child_count, item, focus)) = self.parent_stack.last() {
read_heap_cell!(item,
(HeapCellValueTag::Atom, (_name, arity)) => {
return focus + arity >= idx_loc && *focus < idx_loc;
}
_ => {}
);
}
false
}
}
pub(crate) type LeftistPostOrderHeapIter<'a> = PostOrderIterator<StackfulPreOrderHeapIter<'a>>;
impl<'a> LeftistPostOrderHeapIter<'a> {
#[inline]
pub fn pop_stack(&mut self) {
if let Some((child_count, _)) = self.parent_stack.last() {
if let Some((child_count, ..)) = self.parent_stack.last() {
for _ in 0 .. *child_count {
self.base_iter.pop_stack();
}

107
src/heap_print.rs
View File

@@ -1,6 +1,5 @@
use crate::arena::*;
use crate::atom_table::*;
use crate::instructions::*;
use crate::parser::ast::*;
use crate::parser::rug::{Integer, Rational};
use crate::{
@@ -377,9 +376,9 @@ impl HCValueOutputter for PrinterOutputter {
}
}
#[inline]
fn is_numbered_var(ct: &ClauseType, arity: usize) -> bool {
arity == 1 && ct.name() == atom!("$VAR")
#[inline(always)]
fn is_numbered_var(name: Atom, arity: usize) -> bool {
arity == 1 && name == atom!("$VAR")
}
#[inline]
@@ -469,7 +468,6 @@ pub fn fmt_float(mut fl: f64) -> String {
pub struct HCPrinter<'a, Outputter> {
outputter: Outputter,
iter: StackfulPreOrderHeapIter<'a>,
arena: &'a mut Arena,
op_dir: &'a OpDir,
state_stack: Vec<TokenOrRedirect>,
toplevel_spec: Option<DirectedOp>,
@@ -534,7 +532,6 @@ pub(crate) fn numbervar(offset: &Integer, addr: HeapCellValue) -> Option<String>
impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> {
pub fn new(
heap: &'a mut Heap,
arena: &'a mut Arena,
op_dir: &'a OpDir,
output: Outputter,
cell: HeapCellValue,
@@ -542,7 +539,6 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> {
HCPrinter {
outputter: output,
iter: stackful_preorder_iter(heap, cell),
arena,
op_dir,
state_stack: vec![],
toplevel_spec: None,
@@ -563,9 +559,7 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> {
requires_space(tail, atom)
}
fn enqueue_op(&mut self, mut max_depth: usize, ct: ClauseType, spec: OpDesc) {
let name = ct.name();
fn enqueue_op(&mut self, mut max_depth: usize, name: Atom, spec: OpDesc) {
if is_postfix!(spec.get_spec()) {
if self.check_max_depth(&mut max_depth) {
self.iter.pop_stack();
@@ -652,25 +646,30 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> {
self.iter.pop_stack();
}
self.state_stack.push(TokenOrRedirect::Close);
self.state_stack.push(TokenOrRedirect::Atom(atom!("...")));
self.state_stack.push(TokenOrRedirect::Open);
if arity > 0 {
self.state_stack.push(TokenOrRedirect::Close);
self.state_stack.push(TokenOrRedirect::Atom(atom!("...")));
self.state_stack.push(TokenOrRedirect::Open);
}
self.state_stack.push(TokenOrRedirect::Atom(name));
return false;
}
self.state_stack.push(TokenOrRedirect::Close);
if arity > 0 {
self.state_stack.push(TokenOrRedirect::Close);
for _ in 0..arity {
self.state_stack.push(TokenOrRedirect::FunctorRedirect(max_depth));
self.state_stack.push(TokenOrRedirect::Comma);
for _ in 0..arity {
self.state_stack.push(TokenOrRedirect::FunctorRedirect(max_depth));
self.state_stack.push(TokenOrRedirect::Comma);
}
self.state_stack.pop();
self.state_stack.push(TokenOrRedirect::Open);
}
self.state_stack.pop();
self.state_stack.push(TokenOrRedirect::Open);
self.state_stack.push(TokenOrRedirect::Atom(name));
true
@@ -767,17 +766,16 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> {
&mut self,
max_depth: usize,
arity: usize,
ct: ClauseType,
name: Atom,
op_desc: Option<OpDesc>,
) -> bool {
if self.numbervars && is_numbered_var(&ct, arity) {
if self.numbervars && is_numbered_var(name, arity) {
if self.format_numbered_vars() {
return true;
}
}
let dot_atom = atom!(".");
let name = ct.name();
if let Some(spec) = op_desc {
if dot_atom == name && is_infix!(spec.get_spec()) {
@@ -788,7 +786,7 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> {
}
if !self.ignore_ops && spec.get_prec() > 0 {
self.enqueue_op(max_depth, ct, spec);
self.enqueue_op(max_depth, name, spec);
return true;
}
}
@@ -858,7 +856,7 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> {
None
}
var_opt => {
if is_cyclic && addr.is_compound() {
if is_cyclic && addr.is_compound(self.iter.heap) {
// self-referential variables are marked "cyclic".
match var_opt {
Some(var) => {
@@ -1333,9 +1331,7 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> {
self.state_stack.push(TokenOrRedirect::Close);
}
let ct = ClauseType::from(name, arity);
if self.format_clause(max_depth, arity, ct, Some(op_desc)) && add_brackets {
if self.format_clause(max_depth, arity, name, Some(op_desc)) && add_brackets {
self.state_stack.push(TokenOrRedirect::Open);
if let Some(ref op) = &op {
@@ -1349,10 +1345,7 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> {
#[allow(dead_code)]
fn print_tcp_listener(&mut self, tcp_listener: &TcpListener, max_depth: usize) {
let (ip, port) = if let Some(addr) = tcp_listener.local_addr().ok() {
(
addr.ip(),
Number::arena_from(addr.port() as usize, self.arena),
)
(addr.ip(), addr.port())
} else {
let disconnected_atom = atom!("$disconnected_tcp_listener");
self.state_stack
@@ -1371,7 +1364,7 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> {
self.state_stack.push(TokenOrRedirect::NumberFocus(
max_depth,
NumberFocus::Unfocused(port),
NumberFocus::Unfocused(Number::Fixnum(Fixnum::build_with(port as i64))),
None,
));
self.state_stack.push(TokenOrRedirect::Comma);
@@ -1382,6 +1375,31 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> {
}
}
fn print_index_ptr(&mut self, index_ptr: IndexPtr, max_depth: usize) {
if self.format_struct(max_depth, 1, atom!("$index_ptr")) {
let atom = self.state_stack.pop().unwrap();
self.state_stack.pop();
self.state_stack.pop();
let offset = if index_ptr.is_undefined() || index_ptr.is_dynamic_undefined() {
TokenOrRedirect::Atom(atom!("undefined"))
} else {
let idx = index_ptr.p() as i64;
TokenOrRedirect::NumberFocus(
max_depth,
NumberFocus::Unfocused(Number::Fixnum(Fixnum::build_with(idx))),
None,
)
};
self.state_stack.push(offset);
self.state_stack.push(TokenOrRedirect::Open);
self.state_stack.push(atom);
}
}
fn print_stream(&mut self, stream: Stream, max_depth: usize) {
if let Some(alias) = stream.options().get_alias() {
self.print_atom(alias);
@@ -1439,8 +1457,7 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> {
);
} else {
push_space_if_amb!(self, name.as_str(), {
let ct = ClauseType::from(name, arity);
self.format_clause(max_depth, arity, ct, None);
self.format_clause(max_depth, arity, name, None);
});
}
} else if fetch_op_spec(name, arity, self.op_dir).is_some() {
@@ -1485,8 +1502,7 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> {
);
} else {
push_space_if_amb!(self, name.as_str(), {
let ct = ClauseType::from(name, arity);
self.format_clause(max_depth, arity, ct, None);
self.format_clause(max_depth, arity, name, None);
});
}
}
@@ -1531,10 +1547,13 @@ impl<'a, Outputter: HCValueOutputter> HCPrinter<'a, Outputter> {
self.print_stream(stream, max_depth);
}
(ArenaHeaderTag::OssifiedOpDir, _op_dir) => {
append_str!(self, "'$ossified_op_dir'");
self.print_atom(atom!("$ossified_op_dir"));
}
(ArenaHeaderTag::Dropped, _value) => {
append_str!(self, "'$dropped_value'");
self.print_atom(atom!("$dropped_value"));
}
(ArenaHeaderTag::IndexPtr, index_ptr) => {
self.print_index_ptr(*index_ptr, max_depth);
}
_ => {
}
@@ -1631,7 +1650,6 @@ mod tests {
{
let printer = HCPrinter::new(
&mut wam.machine_st.heap,
&mut wam.machine_st.arena,
&wam.op_dir,
PrinterOutputter::new(),
heap_loc_as_cell!(0)
@@ -1659,7 +1677,6 @@ mod tests {
{
let printer = HCPrinter::new(
&mut wam.machine_st.heap,
&mut wam.machine_st.arena,
&wam.op_dir,
PrinterOutputter::new(),
heap_loc_as_cell!(0)
@@ -1682,7 +1699,6 @@ mod tests {
{
let printer = HCPrinter::new(
&mut wam.machine_st.heap,
&mut wam.machine_st.arena,
&wam.op_dir,
PrinterOutputter::new(),
heap_loc_as_cell!(0)
@@ -1694,7 +1710,6 @@ mod tests {
let mut printer = HCPrinter::new(
&mut wam.machine_st.heap,
&mut wam.machine_st.arena,
&wam.op_dir,
PrinterOutputter::new(),
heap_loc_as_cell!(0)
@@ -1726,7 +1741,6 @@ mod tests {
{
let printer = HCPrinter::new(
&mut wam.machine_st.heap,
&mut wam.machine_st.arena,
&wam.op_dir,
PrinterOutputter::new(),
heap_loc_as_cell!(0),
@@ -1744,7 +1758,6 @@ mod tests {
{
let printer = HCPrinter::new(
&mut wam.machine_st.heap,
&mut wam.machine_st.arena,
&wam.op_dir,
PrinterOutputter::new(),
heap_loc_as_cell!(0),
@@ -1760,7 +1773,6 @@ mod tests {
{
let mut printer = HCPrinter::new(
&mut wam.machine_st.heap,
&mut wam.machine_st.arena,
&wam.op_dir,
PrinterOutputter::new(),
heap_loc_as_cell!(0)
@@ -1791,7 +1803,6 @@ mod tests {
{
let mut printer = HCPrinter::new(
&mut wam.machine_st.heap,
&mut wam.machine_st.arena,
&wam.op_dir,
PrinterOutputter::new(),
heap_loc_as_cell!(0)
@@ -1813,7 +1824,6 @@ mod tests {
{
let printer = HCPrinter::new(
&mut wam.machine_st.heap,
&mut wam.machine_st.arena,
&wam.op_dir,
PrinterOutputter::new(),
pstr_loc_as_cell!(0)
@@ -1840,7 +1850,6 @@ mod tests {
{
let printer = HCPrinter::new(
&mut wam.machine_st.heap,
&mut wam.machine_st.arena,
&wam.op_dir,
PrinterOutputter::new(),
heap_loc_as_cell!(0),

25
src/http.rs Normal file
View File

@@ -0,0 +1,25 @@
use std::sync::Arc;
use std::convert::Infallible;
use hyper::{Response, Request, Body};
use tokio::sync::Mutex;
use tokio::sync::mpsc::{channel, Receiver, Sender};
pub struct HttpListener {
pub incoming: Receiver<HttpRequest>
}
#[derive(Debug)]
pub struct HttpRequest {
pub request: Request<Body>,
pub response: HttpResponse,
}
pub type HttpResponse = Sender<Response<Body>>;
pub async fn serve_req(req: Request<Body>, tx: Arc<Mutex<Sender<HttpRequest>>>) -> Result<Response<Body>, Infallible> {
let (response_tx, mut rx) = channel(1);
let http_request = HttpRequest { request: req, response: response_tx };
tx.lock().await.send(http_request).await.unwrap();
Ok(rx.recv().await.unwrap())
}

13
src/indexing.rs
View File

@@ -1466,17 +1466,20 @@ impl<I: Indexer> CodeOffsets<I> {
atom_tbl: &mut AtomTable,
) {
match optimal_arg {
&Term::Clause(_, atom!("."), ref terms) if terms.len() == 2 => {
clause_index_info.opt_arg_index_key = OptArgIndexKey::List(self.optimal_index, 0);
self.index_list(index);
}
&Term::Cons(..) | &Term::Literal(_, Literal::String(_)) | &Term::PartialString(..) => {
clause_index_info.opt_arg_index_key = OptArgIndexKey::List(self.optimal_index, 0);
self.index_list(index);
}
&Term::Clause(_, name, ref terms) => {
clause_index_info.opt_arg_index_key =
OptArgIndexKey::Structure(self.optimal_index, 0, name.clone(), terms.len());
self.index_structure(name, terms.len(), index);
}
&Term::Cons(..) | &Term::Literal(_, Literal::String(_)) | &Term::PartialString(..) => {
clause_index_info.opt_arg_index_key = OptArgIndexKey::List(self.optimal_index, 0);
self.index_list(index);
}
&Term::Literal(_, constant) => {
let overlapping_constants = self.index_constant(atom_tbl, constant, index);

38
src/iterators.rs
View File

@@ -1,7 +1,6 @@
use crate::atom_table::*;
use crate::forms::*;
use crate::instructions::*;
use crate::machine::machine_indices::*;
use crate::parser::ast::*;
use std::cell::Cell;
@@ -16,7 +15,7 @@ pub(crate) enum TermRef<'a> {
AnonVar(Level),
Cons(Level, &'a Cell<RegType>, &'a Term, &'a Term),
Literal(Level, &'a Cell<RegType>, &'a Literal),
Clause(Level, &'a Cell<RegType>, ClauseType, &'a Vec<Term>),
Clause(Level, &'a Cell<RegType>, Atom, &'a Vec<Term>),
PartialString(Level, &'a Cell<RegType>, &'a String, &'a Box<Term>),
CompleteString(Level, &'a Cell<RegType>, Atom),
Var(Level, &'a Cell<VarReg>, Rc<String>),
@@ -40,7 +39,7 @@ impl<'a> TermRef<'a> {
pub(crate) enum TermIterState<'a> {
AnonVar(Level),
Literal(Level, &'a Cell<RegType>, &'a Literal),
Clause(Level, usize, &'a Cell<RegType>, ClauseType, &'a Vec<Term>),
Clause(Level, usize, &'a Cell<RegType>, Atom, &'a Vec<Term>),
InitialCons(Level, &'a Cell<RegType>, &'a Term, &'a Term),
FinalCons(Level, &'a Cell<RegType>, &'a Term, &'a Term),
InitialPartialString(Level, &'a Cell<RegType>, &'a String, &'a Box<Term>),
@@ -54,8 +53,7 @@ impl<'a> TermIterState<'a> {
match term {
Term::AnonVar => TermIterState::AnonVar(lvl),
Term::Clause(cell, name, subterms) => {
let ct = ClauseType::Named(subterms.len(), *name, CodeIndex::default());
TermIterState::Clause(lvl, 0, cell, ct, subterms)
TermIterState::Clause(lvl, 0, cell, *name, subterms)
}
Term::Cons(cell, head, tail) => {
TermIterState::InitialCons(lvl, cell, head.as_ref(), tail.as_ref())
@@ -105,7 +103,7 @@ impl<'a> QueryIterator<'a> {
Level::Root,
0,
r,
ClauseType::from(*name, terms.len()),
*name,
terms,
),
Term::Var(cell, var) => TermIterState::Var(Level::Root, cell, var.clone()),
@@ -118,14 +116,14 @@ impl<'a> QueryIterator<'a> {
fn new(term: &'a QueryTerm) -> Self {
match term {
&QueryTerm::Clause(ref cell, ClauseType::CallN(arity), ref terms, _) => {
let state = TermIterState::Clause(Level::Root, 1, cell, ClauseType::CallN(arity), terms);
&QueryTerm::Clause(ref cell, ClauseType::CallN(_), ref terms, _) => {
let state = TermIterState::Clause(Level::Root, 1, cell, atom!("$call"), terms);
QueryIterator {
state_stack: vec![state],
}
}
&QueryTerm::Clause(ref cell, ref ct, ref terms, _) => {
let state = TermIterState::Clause(Level::Root, 0, cell, ct.clone(), terms);
let state = TermIterState::Clause(Level::Root, 0, cell, ct.name(), terms);
QueryIterator {
state_stack: vec![state],
}
@@ -167,28 +165,25 @@ impl<'a> Iterator for QueryIterator<'a> {
TermIterState::AnonVar(lvl) => {
return Some(TermRef::AnonVar(lvl));
}
TermIterState::Clause(lvl, child_num, cell, ct, child_terms) => {
TermIterState::Clause(lvl, child_num, cell, name, child_terms) => {
if child_num == child_terms.len() {
match ct {
ClauseType::CallN(_) => {
match name {
atom!("$call") if lvl == Level::Root => {
self.push_subterm(Level::Shallow, &child_terms[0]);
}
ClauseType::Named(..) => {
_ => {
return match lvl {
Level::Root => None,
lvl => Some(TermRef::Clause(lvl, cell, ct, child_terms)),
lvl => Some(TermRef::Clause(lvl, cell, name, child_terms)),
}
}
_ => {
return None;
}
};
} else {
self.state_stack.push(TermIterState::Clause(
lvl,
child_num + 1,
cell,
ct,
name,
child_terms,
));
@@ -257,8 +252,7 @@ impl<'a> FactIterator<'a> {
vec![TermIterState::AnonVar(Level::Root)]
}
Term::Clause(cell, name, terms) => {
let ct = ClauseType::from(*name, terms.len());
vec![TermIterState::Clause(Level::Root, 0, cell, ct, terms)]
vec![TermIterState::Clause(Level::Root, 0, cell, *name, terms)]
}
Term::Cons(cell, head, tail) => vec![TermIterState::InitialCons(
Level::Root,
@@ -305,14 +299,14 @@ impl<'a> Iterator for FactIterator<'a> {
TermIterState::AnonVar(lvl) => {
return Some(TermRef::AnonVar(lvl));
}
TermIterState::Clause(lvl, _, cell, ct, child_terms) => {
TermIterState::Clause(lvl, _, cell, name, child_terms) => {
for child_term in child_terms {
self.push_subterm(lvl.child_level(), child_term);
}
match lvl {
Level::Root if !self.iterable_root => continue,
_ => return Some(TermRef::Clause(lvl, cell, ct, child_terms)),
_ => return Some(TermRef::Clause(lvl, cell, name, child_terms)),
};
}
TermIterState::InitialCons(lvl, cell, head, tail) => {

1
src/lib.rs
View File

@@ -19,6 +19,7 @@ mod fixtures;
mod forms;
mod heap_iter;
pub mod heap_print;
mod http;
mod indexing;
#[macro_use]
pub mod instructions {

362
src/lib/builtins.pl
View File

@@ -1,7 +1,5 @@
:- module(builtins, [(=)/2, (\=)/2, (\+)/1, !/0, (',')/2, (->)/2,
(;)/2, (=..)/2, (:)/2, (:)/3, (:)/4, (:)/5,
(:)/6, (:)/7, (:)/8, (:)/9, (:)/10, (:)/11,
(:)/12, abolish/1, asserta/1, assertz/1,
(;)/2, (=..)/2, abolish/1, asserta/1, assertz/1,
at_end_of_stream/0, at_end_of_stream/1,
atom_chars/2, atom_codes/2, atom_concat/3,
atom_length/2, bagof/3, call/1, call/2, call/3,
@@ -41,81 +39,26 @@ false :- '$fail'.
% Once Scryer is bootstrapped, each is replaced with a version that
% uses expand_goal to pass the expanded goal along to '$call'.
call(G) :- '$call'(G).
call(_).
call(G, A) :- '$call'(G, A).
call(_, _).
call(G, A, B) :- '$call'(G, A, B).
call(_, _, _).
call(G, A, B, C) :- '$call'(G, A, B, C).
call(_, _, _, _).
call(G, A, B, C, D) :- '$call'(G, A, B, C, D).
call(_, _, _, _, _).
call(G, A, B, C, D, E) :- '$call'(G, A, B, C, D, E).
call(_, _, _, _, _, _).
call(G, A, B, C, D, E, F) :- '$call'(G, A, B, C, D, E, F).
call(_, _, _, _, _, _, _).
call(G, A, B, C, D, E, F, G) :- '$call'(G, A, B, C, D, E, F, G).
call(_, _, _, _, _, _, _, _).
call(G, A, B, C, D, E, F, G, H) :- '$call'(G, A, B, C, D, E, F, G, H).
call(_, _, _, _, _, _, _, _, _).
% dynamic module resolution.
Module : Predicate :-
( atom(Module) -> '$module_call'(Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
).
:(Module, Predicate, A1) :-
( atom(Module) ->
'$module_call'(A1, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
).
:(Module, Predicate, A1, A2) :-
( atom(Module) -> '$module_call'(A1, A2, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
).
:(Module, Predicate, A1, A2, A3) :-
( atom(Module) -> '$module_call'(A1, A2, A3, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
).
:(Module, Predicate, A1, A2, A3, A4) :-
( atom(Module) -> '$module_call'(A1, A2, A3, A4, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
).
:(Module, Predicate, A1, A2, A3, A4, A5) :-
( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
).
:(Module, Predicate, A1, A2, A3, A4, A5, A6) :-
( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
).
:(Module, Predicate, A1, A2, A3, A4, A5, A6, A7) :-
( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, A7, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
).
:(Module, Predicate, A1, A2, A3, A4, A5, A6, A7, A8) :-
( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, A7, A8, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
).
:(Module, Predicate, A1, A2, A3, A4, A5, A6, A7, A8, A9) :-
( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, A7, A8, A9, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
).
:(Module, Predicate, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10) :-
( atom(Module) -> '$module_call'(A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2))
).
:- meta_predicate catch(0, ?, 0).
% flags.
@@ -185,7 +128,7 @@ fail :- '$fail'.
:- meta_predicate \+(0).
\+ G :- '$call'(G), !, false.
\+ G :- call(G), !, false.
\+ _.
@@ -195,7 +138,7 @@ _ \= _.
:- meta_predicate once(0).
once(G) :- '$call'(G), !.
once(G) :- call(G), !.
repeat.
@@ -216,17 +159,17 @@ G1 -> G2 :- control_entry_point((G1 -> G2)).
staggered_if_then(G1, G2) :-
'$get_staggered_cp'(B),
'$call'(G1),
call(G1),
'$set_cp'(B),
'$call'(G2).
call(G2).
G1 ; G2 :- control_entry_point((G1 ; G2)).
:- non_counted_backtracking staggered_sc/2.
staggered_sc(G, _) :- '$call'(G).
staggered_sc(_, G) :- '$call'(G).
staggered_sc(G, _) :- call(G).
staggered_sc(_, G) :- call(G).
!.
@@ -257,7 +200,7 @@ control_entry_point_(G) :-
:- non_counted_backtracking cont_list_to_goal/2.
cont_list_goal([Cont], Cont) :- !.
cont_list_goal(Conts, builtins:dispatch_call_list(Conts)).
cont_list_goal(Conts, '$call'(builtins:dispatch_call_list(Conts))).
:- non_counted_backtracking module_qualified_cut/1.
@@ -289,7 +232,7 @@ dispatch_prep(Gs, B, [Cont|Conts]) :-
dispatch_prep(G2, B, IConts1),
cont_list_goal(IConts0, Cont0),
cont_list_goal(IConts1, Cont1),
Cont = builtins:staggered_sc(Cont0, Cont1),
Cont = '$call'(builtins:staggered_sc(Cont0, Cont1)),
Conts = []
; functor(Gs, ->, 2) ->
arg(1, Gs, G1),
@@ -298,10 +241,10 @@ dispatch_prep(Gs, B, [Cont|Conts]) :-
dispatch_prep(G2, B, IConts2),
cont_list_goal(IConts1, Cont1),
cont_list_goal(IConts2, Cont2),
Cont = builtins:staggered_if_then(Cont1, Cont2),
Cont = '$call'(builtins:staggered_if_then(Cont1, Cont2)),
Conts = []
; ( Gs == ! ; module_qualified_cut(Gs) ) ->
Cont = builtins:set_cp(B),
Cont = '$call'(builtins:set_cp(B)),
Conts = []
; Cont = Gs,
Conts = []
@@ -318,56 +261,56 @@ dispatch_prep(Gs, B, [Cont|Conts]) :-
dispatch_call_list([]).
dispatch_call_list([G1,G2,G3,G4,G5,G6,G7,G8|Gs]) :-
!,
'$call_with_inference_counting'('$call'(G1)),
'$call_with_inference_counting'('$call'(G2)),
'$call_with_inference_counting'('$call'(G3)),
'$call_with_inference_counting'('$call'(G4)),
'$call_with_inference_counting'('$call'(G5)),
'$call_with_inference_counting'('$call'(G6)),
'$call_with_inference_counting'('$call'(G7)),
'$call_with_inference_counting'('$call'(G8)),
'$call_with_inference_counting'(call(G1)),
'$call_with_inference_counting'(call(G2)),
'$call_with_inference_counting'(call(G3)),
'$call_with_inference_counting'(call(G4)),
'$call_with_inference_counting'(call(G5)),
'$call_with_inference_counting'(call(G6)),
'$call_with_inference_counting'(call(G7)),
'$call_with_inference_counting'(call(G8)),
dispatch_call_list(Gs).
dispatch_call_list([G1,G2,G3,G4,G5,G6,G7]) :-
!,
'$call_with_inference_counting'('$call'(G1)),
'$call_with_inference_counting'('$call'(G2)),
'$call_with_inference_counting'('$call'(G3)),
'$call_with_inference_counting'('$call'(G4)),
'$call_with_inference_counting'('$call'(G5)),
'$call_with_inference_counting'('$call'(G6)),
'$call_with_inference_counting'('$call'(G7)).
'$call_with_inference_counting'(call(G1)),
'$call_with_inference_counting'(call(G2)),
'$call_with_inference_counting'(call(G3)),
'$call_with_inference_counting'(call(G4)),
'$call_with_inference_counting'(call(G5)),
'$call_with_inference_counting'(call(G6)),
'$call_with_inference_counting'(call(G7)).
dispatch_call_list([G1,G2,G3,G4,G5,G6]) :-
!,
'$call_with_inference_counting'('$call'(G1)),
'$call_with_inference_counting'('$call'(G2)),
'$call_with_inference_counting'('$call'(G3)),
'$call_with_inference_counting'('$call'(G4)),
'$call_with_inference_counting'('$call'(G5)),
'$call_with_inference_counting'('$call'(G6)).
'$call_with_inference_counting'(call(G1)),
'$call_with_inference_counting'(call(G2)),
'$call_with_inference_counting'(call(G3)),
'$call_with_inference_counting'(call(G4)),
'$call_with_inference_counting'(call(G5)),
'$call_with_inference_counting'(call(G6)).
dispatch_call_list([G1,G2,G3,G4,G5]) :-
!,
'$call_with_inference_counting'('$call'(G1)),
'$call_with_inference_counting'('$call'(G2)),
'$call_with_inference_counting'('$call'(G3)),
'$call_with_inference_counting'('$call'(G4)),
'$call_with_inference_counting'('$call'(G5)).
'$call_with_inference_counting'(call(G1)),
'$call_with_inference_counting'(call(G2)),
'$call_with_inference_counting'(call(G3)),
'$call_with_inference_counting'(call(G4)),
'$call_with_inference_counting'(call(G5)).
dispatch_call_list([G1,G2,G3,G4]) :-
!,
'$call_with_inference_counting'('$call'(G1)),
'$call_with_inference_counting'('$call'(G2)),
'$call_with_inference_counting'('$call'(G3)),
'$call_with_inference_counting'('$call'(G4)).
'$call_with_inference_counting'(call(G1)),
'$call_with_inference_counting'(call(G2)),
'$call_with_inference_counting'(call(G3)),
'$call_with_inference_counting'(call(G4)).
dispatch_call_list([G1,G2,G3]) :-
!,
'$call_with_inference_counting'('$call'(G1)),
'$call_with_inference_counting'('$call'(G2)),
'$call_with_inference_counting'('$call'(G3)).
'$call_with_inference_counting'(call(G1)),
'$call_with_inference_counting'(call(G2)),
'$call_with_inference_counting'(call(G3)).
dispatch_call_list([G1,G2]) :-
!,
'$call_with_inference_counting'('$call'(G1)),
'$call_with_inference_counting'('$call'(G2)).
'$call_with_inference_counting'(call(G1)),
'$call_with_inference_counting'(call(G2)).
dispatch_call_list([G1]) :-
'$call_with_inference_counting'('$call'(G1)).
'$call_with_inference_counting'(call(G1)).
% univ.
@@ -444,7 +387,7 @@ get_args([Arg|Args], Func, I0, N) :-
get_args(Args, Func, I1, N).
:- meta_predicate parse_options_list(?, 0, ?, ?, ?).
:- meta_predicate parse_options_list(?, 2, ?, ?, ?).
parse_options_list(Options, Selector, DefaultPairs, OptionValues, Stub) :-
'$skip_max_list'(_, _, Options, Tail),
@@ -455,7 +398,10 @@ parse_options_list(Options, Selector, DefaultPairs, OptionValues, Stub) :-
; Tail \== [] ->
throw(error(type_error(list, Options), Stub)) % 8.11.5.3e)
),
( lists:maplist(nonvar, Options),
( lists:maplist('$call'(nonvar), Options), % need '$call' because
% maplist isn't
% declared as a
% meta-predicate yet
catch(lists:maplist(Selector, Options, OptionPairs0),
error(E, _),
builtins:throw(error(E, Stub))) ->
@@ -619,8 +565,6 @@ term_variables(Term, Vars) :-
% exceptions.
:- meta_predicate catch(0, ?, 0).
:- non_counted_backtracking catch/3.
catch(G,C,R) :-
@@ -633,11 +577,12 @@ catch(G,C,R) :-
catch(G,C,R,Bb) :-
'$install_new_block'(NBb),
'$call_with_inference_counting'('$call'(G)),
'$call_with_inference_counting'(call(G)),
end_block(Bb, NBb).
catch(G,C,R,Bb) :-
'$reset_block'(Bb),
'$get_ball'(Ball),
'$push_ball_stack', % move ball to ball stack.
handle_ball(Ball, C, R).
@@ -654,9 +599,10 @@ end_block(Bb, NBb) :-
handle_ball(C, C, R) :-
!,
'$erase_ball',
'$call'(R).
'$pop_ball_stack', % remove ball from ball stack.
call(R).
handle_ball(_, _, _) :-
'$pop_from_ball_stack', % restore ball from ball stack.
'$unwind_stack'.
:- non_counted_backtracking throw/1.
@@ -671,7 +617,7 @@ throw(Ball) :-
:- non_counted_backtracking '$iterate_find_all'/4.
'$iterate_find_all'(Template, Goal, _, LhOffset) :-
'$call_with_inference_counting'('$call'(Goal)),
'$call_with_inference_counting'(call(Goal)),
'$copy_to_lh'(LhOffset, Template),
'$fail'.
'$iterate_find_all'(_, _, Solutions, LhOffset) :-
@@ -684,6 +630,12 @@ truncate_lh_to(LhLength) :- '$truncate_lh_to'(LhLength).
:- meta_predicate findall(?, 0, ?).
:- non_counted_backtracking findall_cleanup/2.
findall_cleanup(LhLength, Error) :-
truncate_lh_to(LhLength),
throw(Error).
:- non_counted_backtracking findall/3.
findall(Template, Goal, Solutions) :-
@@ -691,13 +643,13 @@ findall(Template, Goal, Solutions) :-
'$lh_length'(LhLength),
catch(builtins:'$iterate_find_all'(Template, Goal, Solutions, LhLength),
Error,
( builtins:truncate_lh_to(LhLength), builtins:throw(Error) )
builtins:findall_cleanup(LhLength, Error)
).
:- non_counted_backtracking '$iterate_find_all_diff'/5.
'$iterate_find_all_diff'(Template, Goal, _, _, LhOffset) :-
'$call_with_inference_counting'('$call'(Goal)),
'$call_with_inference_counting'(call(Goal)),
'$copy_to_lh'(LhOffset, Template),
'$fail'.
'$iterate_find_all_diff'(_, _, Solutions0, Solutions1, LhOffset) :-
@@ -716,7 +668,7 @@ findall(Template, Goal, Solutions0, Solutions1) :-
catch(builtins:'$iterate_find_all_diff'(Template, Goal, Solutions0,
Solutions1, LhLength),
Error,
( builtins:truncate_lh_to(LhLength), builtins:throw(Error) )
builtins:findall_cleanup(LhLength, Error)
).
:- non_counted_backtracking set_difference/3.
@@ -806,7 +758,8 @@ bagof(Template, Goal, Solution) :-
:- non_counted_backtracking iterate_variants_and_sort/3.
iterate_variants_and_sort([V-Solution0|GroupSolutions], V, Solution) :-
sort(Solution0, Solution),
sort(Solution0, Solution1),
Solution1 = Solution,
( GroupSolutions == [] -> !
; true
).
@@ -878,129 +831,35 @@ clause(H, B) :-
).
call_asserta(Head, Body, Name, Arity, Module) :-
'$clause_body_is_valid'(Body),
functor(_, Name, Arity),
'$asserta'(Head, Body, Name, Arity, Module).
module_asserta_clause(Head, Body, Module) :-
( var(Head) ->
throw(error(instantiation_error, asserta/1))
; callable(Head), functor(Head, Name, Arity) ->
( '$head_is_dynamic'(Module, Head) ->
call_asserta(Head, Body, Name, Arity, Module)
; '$no_such_predicate'(Module, Head) ->
call_asserta(Head, Body, Name, Arity, Module)
; throw(error(permission_error(modify, static_procedure, Name/Arity), asserta/1))
)
; throw(error(type_error(callable, Head), asserta/1))
).
asserta_clause(Head, Body) :-
( var(Head) ->
throw(error(instantiation_error, asserta/1))
; callable(Head), functor(Head, Name, Arity) ->
( Name == (:),
Arity =:= 2 ->
arg(1, Head, Module),
arg(2, Head, HeadAndBody),
( HeadAndBody = (F :- Body1) ->
true
; F = HeadAndBody,
Body1 = true
),
module_asserta_clause(F, Body1, Module)
; '$head_is_dynamic'(user, Head) ->
call_asserta(Head, Body, Name, Arity, user)
; '$no_such_predicate'(user, Head) ->
call_asserta(Head, Body, Name, Arity, user)
; throw(error(permission_error(modify, static_procedure, Name/Arity),
asserta/1))
)
; throw(error(type_error(callable, Head), asserta/1))
).
:- meta_predicate asserta(0).
:- meta_predicate asserta(:).
asserta(Clause0) :-
loader:strip_module(Clause0, Module, Clause),
( var(Module) -> Module = user
; true
),
( Clause \= (_ :- _) ->
Head = Clause,
Body = true,
module_asserta_clause(Head, Body, Module)
; Clause = (Head :- Body) ->
module_asserta_clause(Head, Body, Module)
).
loader:strip_subst_module(Clause0, user, Module, Clause),
iso_ext:asserta(Module, Clause).
module_assertz_clause(Head, Body, Module) :-
( var(Head) ->
throw(error(instantiation_error, assertz/1))
; callable(Head), functor(Head, Name, Arity) ->
( '$head_is_dynamic'(Module, Head) ->
call_assertz(Head, Body, Name, Arity, Module)
; '$no_such_predicate'(Module, Head) ->
call_assertz(Head, Body, Name, Arity, Module)
; throw(error(permission_error(modify, static_procedure, Name/Arity),
assertz/1))
)
; throw(error(type_error(callable, Head), assertz/1))
).
call_assertz(Head, Body, Name, Arity, Module) :-
'$clause_body_is_valid'(Body),
functor(_, Name, Arity),
'$assertz'(Head, Body, Name, Arity, Module).
assertz_clause(Head, Body) :-
( var(Head) ->
throw(error(instantiation_error, assertz/1))
; callable(Head), functor(Head, Name, Arity) ->
( Name == (:),
Arity =:= 2 ->
arg(1, Head, Module),
arg(2, Head, HeadAndBody),
( HeadAndBody = (F :- Body1) ->
true
; F = HeadAndBody,
Body1 = true
),
module_assertz_clause(F, Body1, Module)
; '$head_is_dynamic'(user, Head) ->
call_assertz(Head, Body, Name, Arity, user)
; '$no_such_predicate'(user, Head) ->
call_assertz(Head, Body, Name, Arity, user)
; throw(error(permission_error(modify, static_procedure, Name/Arity),
assertz/1))
)
; throw(error(type_error(callable, Head), assertz/1))
).
:- meta_predicate assertz(0).
:- meta_predicate assertz(:).
assertz(Clause0) :-
loader:strip_module(Clause0, Module, Clause),
( var(Module) -> Module = user
; true
),
( Clause \= (_ :- _) ->
Head = Clause,
Body = true,
module_assertz_clause(Head, Body, Module)
; Clause = (Head :- Body) ->
module_assertz_clause(Head, Body, Module)
).
loader:strip_subst_module(Clause0, user, Module, Clause),
iso_ext:assertz(Module, Clause).
:- meta_predicate retract(:).
retract(Clause0) :-
loader:strip_module(Clause0, Module, Clause),
( Clause \= (_ :- _) ->
loader:strip_module(Clause, Module, Head),
( var(Module) -> Module = user
; true
),
Body = true,
retract_module_clause(Head, Body, Module)
; Clause = (Head :- Body) ->
retract_module_clause(Head, Body, Module)
).
module_retract_clauses([Clause|Clauses0], Head, Body, Name, Arity, Module) :-
functor(VarHead, Name, Arity),
findall((VarHead :- VarBody), Module:'$clause'(VarHead, VarBody), Clauses1),
@@ -1086,23 +945,7 @@ retract_clause(Head, Body) :-
).
:- meta_predicate retract(0).
retract(Clause0) :-
loader:strip_module(Clause0, Module, Clause),
( Clause \= (_ :- _) ->
loader:strip_module(Clause, Module, Head),
( var(Module) -> Module = user
; true
),
Body = true,
retract_module_clause(Head, Body, Module)
; Clause = (Head :- Body) ->
retract_module_clause(Head, Body, Module)
).
:- meta_predicate retractall(0).
:- meta_predicate retractall(:).
retractall(Head) :-
retract_clause(Head, _),
@@ -1139,7 +982,7 @@ module_abolish(Pred, Module) :-
).
:- meta_predicate abolish(0).
:- meta_predicate abolish(:).
abolish(Pred) :-
( var(Pred) ->
@@ -1208,7 +1051,6 @@ current_predicate(Pred) :-
can_be_op_priority(Priority) :- var(Priority).
can_be_op_priority(Priority) :- op_priority(Priority).
can_be_op_specifier(Spec) :- var(Spec).
can_be_op_specifier(Spec) :- op_specifier(Spec).

2
src/lib/charsio.pl
View File

@@ -251,7 +251,7 @@ chars_base64(Cs, Bs, Options) :-
'$chars_base64'(Cs, Bs, Padding, Charset)
; must_be(chars, Cs),
( '$first_non_octet'(Cs, N) ->
domain_error(byte_char, N, chars_base64/3)
domain_error(octet_character, N, chars_base64/3)
; '$chars_base64'(Cs, Bs, Padding, Charset)
)
).

2
src/lib/clpb.pl
View File

@@ -1122,6 +1122,8 @@ indomain(1).
% CountAnd = 1.
% ==
sat_count(Sat0, N) :-
catch((parse_sat(Sat0, Sat),
sat_bdd(Sat, BDD),

141
src/lib/clpz.pl
View File

@@ -123,6 +123,8 @@
:- use_module(library(si)).
:- use_module(library(freeze)).
:- use_module(library(arithmetic)).
:- use_module(library(debug)).
:- use_module(library(format)).
% :- use_module(library(types)).
@@ -194,6 +196,8 @@ type_error(Expectation, Term) :-
type_error(Expectation, Term, unknown(Term)-1).
:- meta_predicate(partition(1, ?, ?, ?)).
partition(Pred, Ls0, As, Bs) :-
include(Pred, Ls0, As),
exclude(Pred, Ls0, Bs).
@@ -214,6 +218,8 @@ partition_([X|Xs], Pred, Ls0, Es0, Gs0) :-
include/3 and exclude/3
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
:- meta_predicate(include(1, ?, ?)).
include(Goal, Ls0, Ls) :-
include_(Ls0, Goal, Ls).
@@ -226,6 +232,7 @@ include_([L|Ls0], Goal, Ls) :-
include_(Ls0, Goal, Rest).
:- meta_predicate(exclude(1, ?, ?)).
exclude(Goal, Ls0, Ls) :-
exclude_(Ls0, Goal, Ls).
@@ -2236,8 +2243,8 @@ all_distinct(Ls) :-
fd_must_be_list(Ls, all_distinct(Ls)-1),
maplist(fd_variable, Ls),
make_propagator(pdistinct(Ls), Prop),
distinct_attach(Ls, Prop, []),
trigger_once(Prop).
new_queue(Q0),
phrase((distinct_attach(Ls, Prop, []),trigger_prop(Prop),do_queue), [Q0], _).
%% nvalue(?N, +Vars).
%
@@ -4045,12 +4052,13 @@ trigger_props(fd_props(Gs,Bs,Os)) -->
trigger_props_([]) --> [].
trigger_props_([P|Ps]) --> trigger_prop(P), trigger_props_(Ps).
trigger_prop(_P) :- true. % TODO: What to do?
trigger_prop(P) :- trigger_once(P).
trigger_prop(Propagator) -->
{ propagator_state(Propagator, State) },
( { State == dead } -> []
; { get_attr(State, clpz_aux, queued) } -> []
; { bb_get('$clpz_current_propagator', C), C == State } -> []
; % passive
%{ format("triggering: ~w\n", [Propagator]) },
{ put_attr(State, clpz_aux, queued) },
@@ -4143,12 +4151,13 @@ no_reactivation(pgcc_single(_,_)).
%no_reactivation(scalar_product(_,_,_,_)).
activate_propagator(propagator(P,State)) -->
% { portray_clause(running(P)) },
( State == dead -> []
; { del_attr(State, clpz_aux) },
( { no_reactivation(P) } ->
%b_setval('$clpz_current_propagator', State), TODO
run_propagator(P, State)
%b_setval('$clpz_current_propagator', [])
{ bb_b_put('$clpz_current_propagator', State) },
run_propagator(P, State),
{ bb_b_put('$clpz_current_propagator', []) }
; run_propagator(P, State)
)
).
@@ -4194,7 +4203,8 @@ queue_get_arg_(Queue, Which, Element) :-
).
queue_enabled --> state(queue(_,_,_,Aux)), { \+ get_atts(Aux, +enabled(false)) }.
disable_queue --> state(queue(_,_,_,Aux)), { put_atts(Aux, +enabled(false)) }.
enable_queue --> state(queue(_,_,_,Aux)), { put_atts(Aux, +enabled(true)) }.
portray_propagator(propagator(P,_), F) :- functor(P, F, _).
@@ -4389,14 +4399,14 @@ run_propagator(pdifferent(Left,Right,X,_), MState) -->
run_propagator(pexclude(Left,Right,X), MState).
run_propagator(pexclude(Left,Right,X), _) -->
{ ( ground(X) ->
disable_queue,
exclude_fire(Left, Right, X),
enable_queue
; true
) }.
( ground(X) ->
disable_queue,
exclude_fire(Left, Right, X),
enable_queue
; true
).
run_propagator(pdistinct(Ls), _MState) --> { distinct(Ls) }.
run_propagator(pdistinct(Ls), _MState) --> distinct(Ls).
run_propagator(pnvalue(N, Vars), _MState) --> { propagate_nvalue(N, Vars) }.
@@ -4430,8 +4440,8 @@ run_propagator(pgcc(Vs, _, Pairs), _) --> { gcc_global(Vs, Pairs) }.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
run_propagator(pcircuit(Vs), _MState) -->
{ distinct(Vs),
propagate_circuit(Vs) }.
distinct(Vs),
{ propagate_circuit(Vs) }.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -5928,12 +5938,12 @@ max_factor(L1, U1, L2, U2, Max) :-
CSPs", AAAI-94, Seattle, WA, USA, pp 362--367, 1994
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
distinct_attach([], _, _).
distinct_attach([X|Xs], Prop, Right) :-
distinct_attach([], _, _) --> [].
distinct_attach([X|Xs], Prop, Right) -->
( var(X) ->
init_propagator(X, Prop),
make_propagator(pexclude(Xs,Right,X), P1),
init_propagator(X, P1),
{ init_propagator(X, Prop),
make_propagator(pexclude(Xs,Right,X), P1),
init_propagator(X, P1) },
trigger_prop(P1)
; exclude_fire(Xs, Right, X)
),
@@ -6102,59 +6112,26 @@ put_free(F) :- put_attr(F, free, true).
free_node(F) :- get_attr(F, free, true).
del_vars_attr(Vars, Attr) :- maplist(del_attr(Attr), Vars).
%del_attr_(Attr, Var) :- del_attr(Var, Attr).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
This needs to be spelt out.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
% del_attr_(edges, Var) :- del_attr(Var, edges).
% del_attr_(parent, Var) :- del_attr(Var, parent).
% del_attr_(g0_edges, Var) :- del_attr(Var, g0_edges).
% del_attr_(index, Var) :- del_attr(Var, index).
% del_attr_(visited, Var) :- del_attr(Var, visited).
del_all_attrs(Var) :-
( var(Var) ->
Atts = [clpz,
clpz_aux,
clpz_relation,
edges,
flow,
parent,
free,
g0_edges,
used,
lowlink,
value,
visited,
index,
in_stack,
clpz_gcc_vs,
clpz_gcc_num,
clpz_gcc_occurred],
maplist(remove_attr(Var), Atts)
; true
).
remove_attr(Var, Attr) :-
functor(Term, Attr, 1),
put_atts(Var, -Term).
:- meta_predicate with_local_attributes(?, 0, ?).
:- dynamic(nat_copy/1).
with_local_attributes(Vars, Goal, Result) :-
catch((Goal,
maplist(del_all_attrs, Vars),
% reset all attributes, only the result matters
throw(local_attributes(Result,Vars))),
local_attributes(Result,Vars),
% Create a copy where all attributes are removed. Only
% the result and its relation to Vars matters. We throw
% an exception to undo all modifications to attributes
% we made during propagation, and unify the variables
% in the thrown copy with Vars in order to get the
% intended variables in Result.
asserta(nat_copy(Vars-Result)),
retract(nat_copy(Copy)),
throw(local_attributes(Copy))),
local_attributes(Vars-Result),
true).
distinct(Vars) :-
with_local_attributes(Vars,
distinct(Vars) -->
{ with_local_attributes(Vars,
( difference_arcs(Vars, FreeLeft, FreeRight0),
length(FreeLeft, LFL),
length(FreeRight0, LFR),
@@ -6165,11 +6142,16 @@ distinct(Vars) :-
maplist(g_g0, FreeLeft),
scc(FreeLeft, g0_successors),
maplist(dfs_used, FreeRight),
phrase(distinct_goals(FreeLeft), Gs)), Gs),
phrase(distinct_goals(FreeLeft), Gs)), Gs) },
disable_queue,
maplist(call, Gs),
neq_nums(Gs),
enable_queue.
neq_nums([]) --> [].
neq_nums([neq_num(V,N)|VNs]) -->
% { portray_clause(neq_num(V, N)) },
neq_num(V, N), neq_nums(VNs).
distinct_goals([]) --> [].
distinct_goals([V|Vs]) -->
{ get_attr(V, edges, Es) },
@@ -6184,7 +6166,7 @@ distinct_goals_([flow_to(F,To)|Es], V) -->
get_attr(To, lowlink, L2),
L1 =\= L2 } ->
{ get_attr(To, value, N) },
[clpz:neq_num(V, N)]
[neq_num(V, N)]
; []
),
distinct_goals_(Es, V).
@@ -6376,6 +6358,10 @@ exclude_fire(Left, Right, E) :-
all_neq(Left, E),
all_neq(Right, E).
exclude_fire(Left, Right, E) -->
all_neq(Left, E),
all_neq(Right, E).
list_contains([X|Xs], Y) :-
( X == Y -> true
; list_contains(Xs, Y)
@@ -6937,6 +6923,11 @@ vs_key_min_others([V|Vs], Key, Min0, Min, Others) :-
)
).
all_neq([], _) --> [].
all_neq([X|Xs], C) -->
neq_num(X, C),
all_neq(Xs, C).
all_neq([], _).
all_neq([X|Xs], C) :-
neq_num(X, C),
@@ -6968,8 +6959,8 @@ circuit(Vs) :-
( L =:= 1 -> true
; neq_index(Vs, 1),
make_propagator(pcircuit(Vs), Prop),
distinct_attach(Vs, Prop, []),
trigger_once(Prop)
new_queue(Q0),
phrase((distinct_attach(Vs, Prop, []),trigger_prop(Prop),do_queue), [Q0], _)
).
neq_index([], _).
@@ -7149,10 +7140,6 @@ contribution_at(T, Task, Offset-Bs, Contribution) :-
?(Contribution) #= B*C
).
nth1(I, Es, E) :-
I0 is I-1,
nth0(I0, Es, E).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% disjoint2(+Rectangles)

52
src/lib/crypto.pl
View File

@@ -65,8 +65,7 @@
hex_bytes(Hs, Bytes) :-
( ground(Hs) ->
must_be(list, Hs),
maplist(must_be(atom), Hs),
must_be(chars, Hs),
( phrase(hex_bytes(Hs), Bytes) ->
true
; domain_error(hex_encoding, Hs, hex_bytes/2)
@@ -104,10 +103,10 @@ must_be_bytes(Bytes, Context) :-
).
must_be_byte_chars(Chars, Context) :-
must_be_octet_chars(Chars, Context) :-
must_be(chars, Chars),
( '$first_non_octet'(Chars, F) ->
domain_error(byte_char, F, Context)
domain_error(octet_character, F, Context)
; true
).
@@ -611,7 +610,7 @@ encoding_chars(octet, Bs, Cs) :-
maplist(char_code, Cs, Bs)
; Bs = Cs
),
must_be_byte_chars(Cs, crypto_encoding).
must_be_octet_chars(Cs, crypto_encoding).
encoding_chars(utf8, Cs, Cs) :-
must_be(chars, Cs).
@@ -652,17 +651,17 @@ ed25519_new_keypair(Pair) :-
'$ed25519_new_keypair'(Pair).
ed25519_keypair_public_key(Pair, PublicKey) :-
must_be_byte_chars(Pair, ed25519_keypair_public_key),
must_be_octet_chars(Pair, ed25519_keypair_public_key),
'$ed25519_keypair_public_key'(Pair, PublicKey).
ed25519_sign(Key, Data0, Signature, Options) :-
must_be_byte_chars(Key, ed25519_sign),
must_be_octet_chars(Key, ed25519_sign),
options_data_chars(Options, Data0, Data, Encoding),
'$ed25519_sign'(Key, Data, Encoding, Signature0),
hex_bytes(Signature, Signature0).
ed25519_verify(Key, Data0, Signature0, Options) :-
must_be_byte_chars(Key, ed25519_verify),
must_be_octet_chars(Key, ed25519_verify),
options_data_chars(Options, Data0, Data, Encoding),
hex_bytes(Signature0, Signature),
'$ed25519_verify'(Key, Data, Encoding, Signature).
@@ -714,12 +713,17 @@ curve25519_scalar_mult(Scalar, Point, Result) :-
'$curve25519_scalar_mult'(ScalarBytes, PointBytes, Result).
bytes_integer(Bs, N) :-
foldl(pow, Bs, 0-0, N-_).
foldl(pow, Bs, t(0,0,N), t(N,_,_)).
pow(B, N0-I0, N-I) :-
pow(B, t(N0,P0,I0), t(N,P,I)) :-
( integer(I0) ->
B #= I0 mod 256,
I #= I0 >> 8
; true
),
B in 0..255,
N #= N0 + B*256^I0,
I #= I0 + 1.
N #= N0 + B*256^P0,
P #= P0 + 1.
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Operations on Elliptic Curves
@@ -762,11 +766,15 @@ crypto_curve_scalar_mult(Curve, Scalar, point(X,Y), point(RX, RY)) :-
curve_name(Curve, Name),
curve_field_length(Curve, L0),
L #= 2*L0, % for hex encoding
phrase(format_("04~|~`0t~16r~*+~`0t~16r~*+", [X,L,Y,L]), Hex),
hex_bytes(Hex, Bytes),
'$crypto_curve_scalar_mult'(Name, Scalar, Bytes, SX, SY),
number_chars(RX, SX),
number_chars(RY, SY).
phrase(format_("04~|~`0t~16r~*+~`0t~16r~*+", [X,L,Y,L]), PointHex),
hex_bytes(PointHex, PointBytes),
once(bytes_integer(ScalarBytes, Scalar)),
'$crypto_curve_scalar_mult'(Name, ScalarBytes, PointBytes, [_|Us]),
maplist(char_code, Us, Bs),
length(XBs, 32),
append(XBs, YBs, Bs),
maplist(reverse, [XBs,YBs], RBs),
maplist(bytes_integer, RBs, [RX,RY]).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
?- crypto_name_curve(secp256k1, Curve),
@@ -818,16 +826,6 @@ fitting_exponent(N, E0, E) :-
fitting_exponent(N, E1, E)
).
crypto_name_curve(secp112r1,
curve(secp112r1,
0x00db7c2abf62e35e668076bead208b,
0x00db7c2abf62e35e668076bead2088,
0x659ef8ba043916eede8911702b22,
point(0x09487239995a5ee76b55f9c2f098,
0xa89ce5af8724c0a23e0e0ff77500),
0x00db7c2abf62e35e7628dfac6561c5,
14,
1)).
crypto_name_curve(secp256k1,
curve(secp256k1,
0x00fffffffffffffffffffffffffffffffffffffffffffffffffffffffefffffc2f,

114
src/lib/dcgs.pl
View File

@@ -12,16 +12,6 @@
:- use_module(library(lists), [append/3, member/2]).
:- use_module(library(loader), [strip_module/3]).
load_context(GRBody, Module, GRBody0) :-
strip_module(GRBody, Module, GRBody0),
( nonvar(Module) ->
true
; prolog_load_context(module, Module) ->
true
; true
).
:- meta_predicate phrase(2, ?).
:- meta_predicate phrase(2, ?, ?).
@@ -30,12 +20,14 @@ phrase(GRBody, S0) :-
phrase(GRBody, S0, []).
phrase(GRBody, S0, S) :-
load_context(GRBody, Module, GRBody0),
( var(GRBody0) ->
strip_module(GRBody, M, GRBody1),
( var(GRBody) ->
instantiation_error(phrase/3)
; dcg_body(GRBody0, S0, S, GRBody1, Module) ->
call(GRBody1)
; type_error(callable, GRBody0, phrase/3)
; nonvar(GRBody1),
dcg_constr(GRBody1),
dcg_body(GRBody1, S0, S, GRBody2) ->
call(M:GRBody2)
; call(M:GRBody1, S0, S)
).
@@ -48,25 +40,25 @@ module_call_qualified(M, Call, Call1) :-
% The same version of the below two dcg_rule clauses, but with module scoping.
dcg_rule(( M:NonTerminal, Terminals --> GRBody ), ( M:Head :- Body )) :-
dcg_non_terminal(NonTerminal, S0, S, Head),
dcg_body(GRBody, S0, S1, Goal1, _),
dcg_body(GRBody, S0, S1, Goal1),
dcg_terminals(Terminals, S, S1, Goal2),
Body = ( Goal1, Goal2 ).
dcg_rule(( M:NonTerminal --> GRBody ), ( M:Head :- Body )) :-
NonTerminal \= ( _, _ ),
dcg_non_terminal(NonTerminal, S0, S, Head),
dcg_body(GRBody, S0, S, Body, _).
dcg_body(GRBody, S0, S, Body).
% This program uses append/3 as defined in the Prolog prologue.
% Expands a DCG rule into a Prolog rule, when no error condition applies.
dcg_rule(( NonTerminal, Terminals --> GRBody ), ( Head :- Body )) :-
dcg_non_terminal(NonTerminal, S0, S, Head),
dcg_body(GRBody, S0, S1, Goal1, _),
dcg_body(GRBody, S0, S1, Goal1),
dcg_terminals(Terminals, S, S1, Goal2),
Body = ( Goal1, Goal2 ).
dcg_rule(( NonTerminal --> GRBody ), ( Head :- Body )) :-
NonTerminal \= ( _, _ ),
dcg_non_terminal(NonTerminal, S0, S, Head),
dcg_body(GRBody, S0, S, Body, _).
dcg_body(GRBody, S0, S, Body).
dcg_non_terminal(NonTerminal, S0, S, Goal) :-
NonTerminal =.. NonTerminalUniv,
@@ -76,21 +68,21 @@ dcg_non_terminal(NonTerminal, S0, S, Goal) :-
dcg_terminals(Terminals, S0, S, S0 = List) :-
append(Terminals, S, List).
dcg_body(Var, S0, S, Body, M) :-
dcg_body(Var, S0, S, Body) :-
var(Var),
module_call_qualified(M, Var, Var1),
Body = phrase(Var1, S0, S).
dcg_body(GRBody, S0, S, Body, M) :-
Body = phrase(Var, S0, S).
dcg_body(GRBody, S0, S, Body) :-
nonvar(GRBody),
dcg_constr(GRBody),
dcg_cbody(GRBody, S0, S, Body, M).
dcg_body(NonTerminal, S0, S, Goal1, M) :-
dcg_cbody(GRBody, S0, S, Body).
dcg_body(NonTerminal, S0, S, Goal1) :-
nonvar(NonTerminal),
\+ dcg_constr(NonTerminal),
NonTerminal \= ( _ -> _ ),
NonTerminal \= ( \+ _ ),
module_call_qualified(M, Goal, Goal1),
dcg_non_terminal(NonTerminal, S0, S, Goal).
loader:strip_module(NonTerminal, M, NonTerminal0),
dcg_non_terminal(NonTerminal0, S0, S, Goal0),
module_call_qualified(M, Goal0, Goal1).
% The following constructs in a grammar rule body
% are defined in the corresponding subclauses.
@@ -108,42 +100,44 @@ dcg_constr((_->_)). % 7.14.12 - if-then (existence implementation dep.)
% The principal functor of the first argument indicates
% the construct to be expanded.
dcg_cbody([], S0, S, S0 = S, _M).
dcg_cbody([T|Ts], S0, S, Goal, _M) :-
dcg_cbody([], S0, S, S0 = S).
dcg_cbody([T|Ts], S0, S, Goal) :-
must_be(list, [T|Ts]),
dcg_terminals([T|Ts], S0, S, Goal).
dcg_cbody(( GRFirst, GRSecond ), S0, S, ( First, Second ), M) :-
dcg_body(GRFirst, S0, S1, First, M),
dcg_body(GRSecond, S1, S, Second, M).
dcg_cbody(( GREither ; GROr ), S0, S, ( Either ; Or ), M) :-
dcg_cbody(( GRFirst, GRSecond ), S0, S, ( First, Second )) :-
dcg_body(GRFirst, S0, S1, First),
dcg_body(GRSecond, S1, S, Second).
dcg_cbody(( GREither ; GROr ), S0, S, ( Either ; Or )) :-
\+ subsumes_term(( _ -> _ ), GREither),
dcg_body(GREither, S0, S, Either, M),
dcg_body(GROr, S0, S, Or, M).
dcg_cbody(( GRCond ; GRElse ), S0, S, ( Cond ; Else ), M) :-
dcg_body(GREither, S0, S, Either),
dcg_body(GROr, S0, S, Or).
dcg_cbody(( GRCond ; GRElse ), S0, S, ( Cond ; Else )) :-
subsumes_term(( _GRIf -> _GRThen ), GRCond),
dcg_cbody(GRCond, S0, S, Cond, M),
dcg_body(GRElse, S0, S, Else, M).
dcg_cbody(( GREither '|' GROr ), S0, S, ( Either ; Or ), M) :-
dcg_body(GREither, S0, S, Either, M),
dcg_body(GROr, S0, S, Or, M).
dcg_cbody({Goal}, S0, S, ( Goal1, S0 = S ), M) :-
module_call_qualified(M, Goal, Goal1).
dcg_cbody(call(Cont), S0, S, call(Cont1, S0, S), M) :-
module_call_qualified(M, Cont, Cont1).
dcg_cbody(phrase(Body), S0, S, phrase(Body1, S0, S), M) :-
module_call_qualified(M, Body, Body1).
dcg_cbody(!, S0, S, ( !, S0 = S ), _M).
dcg_cbody(\+ GRBody, S0, S, ( \+ phrase(GRBody1,S0,_), S0 = S ), M) :-
module_call_qualified(M, GRBody, GRBody1).
dcg_cbody(( GRIf -> GRThen ), S0, S, ( If -> Then ), M) :-
dcg_body(GRIf, S0, S1, If, M),
dcg_body(GRThen, S1, S, Then, M).
dcg_cbody(GRCond, S0, S, Cond),
dcg_body(GRElse, S0, S, Else).
dcg_cbody(( GREither '|' GROr ), S0, S, ( Either ; Or )) :-
dcg_body(GREither, S0, S, Either),
dcg_body(GROr, S0, S, Or).
dcg_cbody({Goal}, S0, S, ( Goal, S0 = S )).
dcg_cbody(call(Cont), S0, S, call(Cont, S0, S)).
dcg_cbody(phrase(Body), S0, S, phrase(Body, S0, S)).
dcg_cbody(!, S0, S, ( !, S0 = S )).
dcg_cbody(\+ GRBody, S0, S, ( \+ phrase(GRBody,S0,_), S0 = S )).
dcg_cbody(( GRIf -> GRThen ), S0, S, ( If -> Then )) :-
dcg_body(GRIf, S0, S1, If),
dcg_body(GRThen, S1, S, Then).
user:term_expansion(Term0, Term) :-
nonvar(Term0),
dcg_rule(Term0, Term).
% Describes a sequence
seq(Xs, Cs0,Cs) :-
var(Xs),
Cs0 == [],
!,
Xs = [],
Cs0 = Cs.
seq([]) --> [].
seq([E|Es]) --> [E], seq(Es).
@@ -152,19 +146,23 @@ seqq([]) --> [].
seqq([Es|Ess]) --> seq(Es), seqq(Ess).
% Describes an arbitrary number of elements
...(Cs0,Cs) :-
Cs0 == [],
!,
Cs0 = Cs.
... --> [] | [_], ... .
error_goal(error(E, must_be/2), error(E, must_be/2)).
error_goal(error(E, (=..)/2), error(E, (=..)/2)).
error_goal(E, _) :- throw(E).
user:goal_expansion(phrase(GRBody, S, S0), GRBody1) :-
load_context(GRBody, M, GRBody0),
user:goal_expansion(phrase(GRBody, S, S0), GRBody2) :-
loader:strip_module(GRBody, M, GRBody0),
nonvar(GRBody0),
catch(dcgs:dcg_body(GRBody0, S, S0, GRBody1, M),
catch(dcgs:dcg_body(GRBody0, S, S0, GRBody1),
E,
dcgs:error_goal(E, GRBody1)
).
),
module_call_qualified(M, GRBody1, GRBody2).
user:goal_expansion(phrase(GRBody, S), phrase(GRBody, S, [])).

47
src/lib/error.pl
View File

@@ -10,6 +10,10 @@
type_error/3
]).
:- meta_predicate check_(1, ?, ?).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
must_be(Type, Term)
@@ -31,6 +35,8 @@
- in_character
- integer
- list
- octet_character
- octet_chars
- term
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
@@ -46,6 +52,11 @@ must_be_(var, Term) :-
; throw(error(uninstantiation_error(Term), must_be/2))
).
must_be_(integer, Term) :- check_(integer, integer, Term).
must_be_(not_less_than_zero, N) :-
must_be(integer, N),
( N >= 0 -> true
; domain_error(not_less_than_zero, N, must_be/2)
).
must_be_(atom, Term) :- check_(atom, atom, Term).
must_be_(character, T) :- check_(error:character, character, T).
must_be_(in_character, T) :- check_(error:in_character, in_character, T).
@@ -59,6 +70,17 @@ must_be_(chars, Ls) :-
true
; all_characters(Ls)
).
must_be_(octet_character, C) :-
must_be(character, C),
( octet_character(C) -> true
; domain_error(octet_character, C, must_be/2)
).
must_be_(octet_chars, Cs) :-
must_be(chars, Cs),
( '$first_non_octet'(Cs, C) ->
domain_error(octet_character, C, must_be/2)
; true
).
must_be_(list, Term) :- check_(error:ilist, list, Term).
must_be_(type, Term) :- check_(error:type, type, Term).
must_be_(boolean, Term) :- check_(error:boolean, boolean, Term).
@@ -90,6 +112,10 @@ character(C) :-
atom(C),
atom_length(C, 1).
octet_character(C) :-
char_code(C, Code),
0 =< Code, Code =< 0xff.
in_character(C) :-
( character(C)
; C == end_of_file
@@ -107,11 +133,14 @@ type(integer).
type(atom).
type(character).
type(in_character).
type(octet_character).
type(octet_chars).
type(chars).
type(list).
type(var).
type(boolean).
type(term).
type(not_less_than_zero).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
can_be(Type, Term)
@@ -135,6 +164,13 @@ can_be(Type, Term) :-
).
can_(integer, Term) :- integer(Term).
can_(not_less_than_zero, N) :-
( integer(N) ->
( N >= 0 -> true
; domain_error(not_less_than_zero, N, can_be/2)
)
; type_error(integer, N, can_be/2)
).
can_(atom, Term) :- atom(Term).
can_(character, T) :- character(T).
can_(in_character, T) :- in_character(T).
@@ -143,6 +179,17 @@ can_(chars, Ls) :-
; can_be(list, Ls),
can_be_chars(Ls)
).
can_(octet_character, C) :-
( octet_character(C) -> true
; domain_error(octet_character, C, can_be/2)
).
can_(octet_chars, Cs) :-
can_be(chars, Cs),
( '$skip_max_list'(_, _, Cs, []), % temporarily turn Cs into a list
'$first_non_octet'(Cs, C) ->
domain_error(octet_character, C, can_be/2)
; true
).
can_(list, Term) :- list_or_partial_list(Term).
can_(boolean, Term) :- boolean(Term).
can_(term, Term) :-

22
src/lib/files.pl
View File

@@ -1,5 +1,5 @@
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Written June 2020 by Markus Triska (triska@metalevel.at)
Written 2020, 2022 by Markus Triska (triska@metalevel.at)
Part of Scryer Prolog.
Predicates for reasoning about files and directories.
@@ -65,6 +65,7 @@
:- use_module(library(error)).
:- use_module(library(lists)).
:- use_module(library(charsio)).
:- use_module(library(dcgs)).
directory_files(Directory, Files) :-
must_be(chars, Directory),
@@ -73,7 +74,6 @@ directory_files(Directory, Files) :-
file_size(File, Size) :-
file_must_exist(File, file_size/2),
must_be(chars, File),
can_be(integer, Size),
'$file_size'(File, Size).
@@ -95,12 +95,10 @@ make_directory_path(Directory) :-
delete_file(File) :-
file_must_exist(File, delete_file/1),
must_be(chars, File),
'$delete_file'(File).
rename_file(File, Renamed) :-
file_must_exist(File, rename_file/2),
must_be(chars, File),
must_be(chars, Renamed),
'$rename_file'(File, Renamed).
@@ -201,19 +199,19 @@ path_segments(Path, Segments) :-
( var(Path) ->
must_be(list, Segments),
maplist(must_be(chars), Segments),
append_with_separator(Segments, Sep, Path)
phrase(append_with_separator(Segments, Sep), Path)
; must_be(chars, Path),
path_to_segments(Path, Sep, Segments)
).
append_with_separator([], _, []).
append_with_separator([Segment|Segments], Sep, Path) :-
append_with_separator_(Segments, Segment, Sep, Path).
append_with_separator([], _) --> [].
append_with_separator([Segment|Segments], Sep) -->
append_with_separator_(Segments, Segment, Sep).
append_with_separator_([], Segment, _, Segment).
append_with_separator_([Segment|Segments], Prev, Sep, Path) :-
append(Prev, [Sep|Rest], Path),
append_with_separator_(Segments, Segment, Sep, Rest).
append_with_separator_([], Segment, _) --> seq(Segment).
append_with_separator_([Segment|Segments], Prev, Sep) -->
seq(Prev), [Sep],
append_with_separator_(Segments, Segment, Sep).
path_to_segments(Path, Sep, Segments) :-
( append(Front, [Sep|Ps], Path) ->

2
src/lib/freeze.pl
View File

@@ -3,7 +3,7 @@
:- use_module(library(atts)).
:- use_module(library(dcgs)).
:- meta_predicate freeze(?, 0).
:- meta_predicate freeze(-, 0).
:- attribute frozen/1.

351
src/lib/http/http_server.pl
View File

@@ -1,11 +1,11 @@
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Written in December 2020 by Adrián Arroyo (adrian.arroyocalle@gmail.com)
Updated in March 2022 by Adrián Arroyo to use the Hyper backend
Part of Scryer Prolog
This library provides an starting point to build HTTP server based applications.
It currently implements a subset of HTTP/1.0. It is recommended to put a reverse
proxy like nginx in front of this server to have access to more advanced features
(gzip compression, HTTPS, ...)
It is based on Hyper, which allows for HTTP/1.0, HTTP/1.1 and HTTP/2. However,
some advanced features that Hyper provides are still not accesible.
Usage
==========
@@ -41,37 +41,36 @@
Some things that are still missing:
- Read forms in multipart format
- HTTP Basic Auth
- Keep-Alive support
- Session handling via cookies
- HTML Templating
I place this code in the public domain. Use it in any way you want.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
:- module(http_server, [
http_listen/2,
http_headers/2,
http_status_code/2,
http_body/2,
http_redirect/2,
http_query/3,
url_decode//1
http_listen/2,
http_headers/2,
http_status_code/2,
http_body/2,
http_redirect/2,
http_query/3
]).
:- meta_predicate http_listen(?, 2).
:- meta_predicate http_listen(?, :).
:- use_module(library(sockets)).
:- use_module(library(dcgs)).
:- use_module(library(format)).
:- use_module(library(error)).
:- use_module(library(charsio)).
:- use_module(library(lists)).
:- use_module(library(iso_ext)).
:- use_module(library(time)).
:- use_module(library(crypto)).
:- use_module(library(error)).
:- use_module(library(format)).
:- use_module(library(iso_ext)).
:- use_module(library(lists)).
:- use_module(library(pio)).
:- use_module(library(time)).
% Module prefix workaround with meta_predicate
http_listen(Port, Module:Handlers0) :-
must_be(integer, Port),
must_be(list, Handlers0),
maplist(module_qualification(Module), Handlers0, Handlers),
http_listen_(Port, Handlers).
@@ -79,49 +78,84 @@ module_qualification(M, H0, H) :-
H0 =.. [Method, Path, Goal],
H =.. [Method, Path, M:Goal].
% Server initialization
http_listen_(Port, Handlers) :-
must_be(integer, Port),
must_be(list, Handlers),
once(socket_server_open(Port, Socket)),
format("Listening at port ~d\n", [Port]),
accept_loop(Socket, Handlers).
phrase(format_("0.0.0.0:~d", [Port]), Addr),
'$http_listen'(Addr, HttpListener),!,
format("Listening at ~s\n", [Addr]),
http_loop(HttpListener, Handlers).
% Server loop
accept_loop(Socket, Handlers) :-
setup_call_cleanup(socket_server_accept(Socket, _Client, Stream, [type(binary)]),
(
read_header_lines(Stream, Lines),
[Request|Headers] = Lines,
(
(phrase(parse_request(_Version, Method, Path, Queries), Request), maplist(map_parse_header, Headers, HeadersKV)) -> (
(
member("content-length"-ContentLength, HeadersKV) ->
(number_chars(ContentLengthN, ContentLength), get_bytes(Stream, ContentLengthN, Body))
;true
),
current_time(Time),
phrase(format_time("%Y-%m-%d (%H:%M:%S)", Time), TimeString),
format("~s ~w ~s\n", [TimeString, Method, Path]),
(
match_handler(Handlers, Method, Path, Handler) ->
(
HttpRequest = http_request(HeadersKV, binary(Body), Queries),
HttpResponse = http_response(_, _, _),
(call(Handler, HttpRequest, HttpResponse) ->
send_response(Stream, HttpResponse)
; format(Stream, "HTTP/1.0 500 Internal Server Error\r\n\r\n", [])
)
)
; format(Stream, "HTTP/1.0 404 Not Found\r\n\r\n", [])
)
);(
format(Stream, "HTTP/1.0 400 Bad Request\r\n\r\n", []) % bad format
)
),
! % Remove
), close(Stream)),
accept_loop(Socket, Handlers).
http_loop(HttpListener, Handlers) :-
'$http_accept'(HttpListener, RequestMethod, RequestPath, RequestHeaders, RequestQuery, RequestStream, ResponseHandle),
current_time(Time),
phrase(format_time("%Y-%m-%d (%H:%M:%S)", Time), TimeString),
format("~s ~w ~s\n", [TimeString, RequestMethod, RequestPath]),
maplist(map_header_kv, RequestHeaders, RequestHeadersKV),
phrase(parse_queries(RequestQueries), RequestQuery),
(
match_handler(Handlers, RequestMethod, RequestPath, Handler) ->
(
HttpRequest = http_request(RequestHeadersKV, stream(RequestStream), RequestQueries),
HttpResponse = http_response(_, _, _),
(call(Handler, HttpRequest, HttpResponse) ->
send_response(ResponseHandle, HttpResponse)
; (
'$http_answer'(ResponseHandle, 500, [], ResponseStream),
call_cleanup(format(ResponseStream, "Internal Server Error", []), close(ResponseStream)))
)
)
; (
'$http_answer'(ResponseHandle, 404, [], ResponseStream),
call_cleanup(format(ResponseStream, "Not Found"), close(ResponseStream)))
),
http_loop(HttpListener, Handlers).
send_response(ResponseHandle, http_response(StatusCode0, text(ResponseText), ResponseHeaders0)) :-
default(StatusCode0, 200, StatusCode),
maplist(map_header_kv_2, ResponseHeaders, ResponseHeaders0),
'$http_answer'(ResponseHandle, StatusCode, ResponseHeaders, ResponseStream),
call_cleanup(
format(ResponseStream, "~s", [ResponseText]),
close(ResponseStream)
).
send_response(ResponseHandle, http_response(StatusCode0, bytes(ResponseBytes), ResponseHeaders0)) :-
default(StatusCode0, 200, StatusCode),
maplist(map_header_kv_2, ResponseHeaders, ResponseHeaders0),
'$http_answer'(ResponseHandle, StatusCode, ResponseHeaders, ResponseStream),
call_cleanup(
format(ResponseStream, "~s", [ResponseBytes]),
close(ResponseStream)
).
send_response(ResponseHandle, http_response(StatusCode0, file(Filename), ResponseHeaders0)) :-
default(StatusCode0, 200, StatusCode),
maplist(map_header_kv_2, ResponseHeaders, ResponseHeaders0),
'$http_answer'(ResponseHandle, StatusCode, ResponseHeaders, ResponseStream),
call_cleanup(
setup_call_cleanup(
open(Filename, read, FileStream, [type(binary)]),
(
get_n_chars(FileStream, _, FileCs),
format(ResponseStream, "~s", [FileCs])
),
close(FileStream)
),
close(ResponseStream)
).
default(Var, Default, Out) :-
(var(Var) -> Out = Default
; Var = Out
).
map_header_kv(T, K-V) :-
T =.. [K0, V],
atom_chars(K0, K).
map_header_kv_2(T, K-V) :-
atom_chars(K0, K),
T =.. [K0, V].
match_handler(Handlers, Method, "/", Handler) :-
member(H, Handlers),
@@ -139,27 +173,6 @@ match_handler(Handlers, Method, Path, Handler) :-
var(Var),
Var = Path.
% Helper and recommended predicates
http_headers(http_request(Headers, _, _), Headers).
http_headers(http_response(_, _, Headers), Headers).
http_body(http_request(_, binary(ByteBody), _), text(TextBody)) :- chars_utf8bytes(TextBody, ByteBody).
http_body(http_request(Headers, binary(ByteBody), _), form(FormBody)) :-
member("content-type"-"application/x-www-form-urlencoded", Headers),
chars_utf8bytes(TextBody, ByteBody),
phrase(parse_queries(FormBody), TextBody).
http_body(http_request(_, Body, _), Body).
http_body(http_response(_, Body, _), Body).
http_status_code(http_response(StatusCode, _, _), StatusCode).
http_redirect(http_response(307, text("Moved Temporarily"), ["Location"-Uri]), Uri).
http_query(http_request(_, _, Queries), Key, Value) :- member(Key-Value, Queries).
% Route matching
path(Pattern) -->
{
Pattern =.. Parts,
@@ -183,76 +196,31 @@ path(Pattern) -->
path([]) --> [].
% Send responses
send_response(Stream, http_response(StatusCode0, file(Filename), Headers)) :-
default(StatusCode0, 200, StatusCode),
format(Stream, "HTTP/1.0 ~d\r\n", [StatusCode]),
overwrite_header("connection"-"Close", Headers, Headers0),
write_headers(Stream, Headers0),
format(Stream, "\r\n", []),
setup_call_cleanup(
open(Filename, read, FileStream, [type(binary)]),
pipe_bytes(FileStream, Stream),
close(FileStream)
).
string_without(Not, [Char|String]) -->
[Char],
{
\+ member(Char, Not)
},
string_without(Not, String).
send_response(Stream, http_response(StatusCode0, text(TextResponse), Headers)) :-
default(StatusCode0, 200, StatusCode),
format(Stream, "HTTP/1.0 ~d\r\n", [StatusCode]),
overwrite_header("content-type"-"text/plain", Headers, Headers0),
overwrite_header("connection"-"Close", Headers0, Headers1),
write_headers(Stream, Headers1),
format(Stream, "\r\n~s", [TextResponse]).
string_without(_, []) -->
[].
send_response(Stream, http_response(StatusCode0, binary(BinaryResponse), Headers)) :-
default(StatusCode0, 200, StatusCode),
format(Stream, "HTTP/1.0 ~d\r\n", [StatusCode]),
overwrite_header("connection"-"Close", Headers, Headers0),
write_headers(Stream, Headers0),
format(Stream, "\r\n", []),
put_bytes(Stream, BinaryResponse).
http_headers(http_request(Headers, _, _), Headers).
http_headers(http_response(_, _, Headers), Headers).
default(Var, Default, Out) :-
(var(Var) -> Out = Default
; Var = Out
).
http_body(http_request(_, stream(StreamBody), _), bytes(BytesBody)) :- get_n_chars(StreamBody, _, BytesBody).
http_body(http_request(_, stream(StreamBody), _), text(TextBody)) :- get_n_chars(StreamBody, _, TextBody).
http_body(http_request(Headers, stream(StreamBody), _), form(FormBody)) :-
member("content-type"-"application/x-www-form-urlencoded", Headers),
get_n_chars(StreamBody, _, TextBody),
phrase(parse_queries(FormBody), TextBody).
http_body(http_request(_, Body, _), Body).
http_body(http_response(_, Body, _), Body).
header([]) --> [].
header([Key-Value|Headers]) -->
format_("~s: ~s\r\n", [Key, Value]),
header(Headers).
write_headers(Stream, Headers) :-
phrase(header(Headers), Cs),
format(Stream, "~s", [Cs]).
overwrite_header(Key-Value, [], [Key-Value]).
overwrite_header(Key-Value, [Header|Headers], [Header|HeadersOut]) :-
Header = Key0-_,
Key0 \= Key,
overwrite_header(Key-Value, Headers, HeadersOut).
overwrite_header(Key-Value, [Header|Headers], [NewHeader|Headers]) :-
Header = Key-_,
NewHeader = Key-Value.
parse_request(http_version(Major, Minor), Method, Path, Queries) -->
method(Method),
" ",
parse_path(Path, Queries),
" ",
"HTTP/",
natural(Major),
".",
natural(Minor),
"\r\n".
parse_path(Path, Queries) -->
string_without("?", Path),
"?",
parse_queries(Queries).
parse_path(Path, []) -->
string_without(" ", Path).
http_status_code(http_response(StatusCode, _, _), StatusCode).
http_redirect(http_response(307, text("Moved Temporarily"), ["Location"-Uri]), Uri).
http_query(http_request(_, _, Queries), Key, Value) :- member(Key-Value, Queries).
parse_queries([Key-Value|Queries]) -->
string_without("=", Key0),
@@ -278,94 +246,9 @@ parse_queries([Key-Value]) -->
phrase(url_decode(Value), Value0)
}.
map_parse_header(Header, HeaderKV) :-
phrase(parse_header(HeaderKV), Header).
parse_header(Key-Value) -->
string_without(":", Key0),
{
chars_lower(Key0, Key)
},
": ",
string_without("\r", Value),
"\r\n".
method(options) --> "OPTIONS".
method(get) --> "GET".
method(head) --> "HEAD".
method(post) --> "POST".
method(put) --> "PUT".
method(delete) --> "DELETE".
string_without(Not, [Char|String]) -->
[Char],
{
\+ member(Char, Not)
},
string_without(Not, String).
string_without(_, []) -->
parse_queries([]) -->
[].
natural(Nat) -->
natural_(NatChars),
{
number_chars(Nat, NatChars)
}.
natural_([Nat|Nats]) -->
[Nat],
{
char_type(Nat, decimal_digit)
},
natural_(Nats).
natural_([]) -->
[].
read_header_lines(Stream, Hs) :-
read_line_to_chars(Stream, Cs, []),
( Cs == "" -> Hs = []
; Cs == "\r\n" -> Hs = []
; Hs = [Cs|Rest],
read_header_lines(Stream, Rest)
).
get_bytes(Stream, Length, Res) :- get_bytes(Stream, Length, [], Res).
get_bytes(Stream, Length, Acc, Res) :-
(Length > 0 -> (
get_byte(Stream, B),
B =\= -1,
get_bytes(Stream, Length - 1, [B|Acc], Res)
); reverse(Acc, Res)).
put_bytes(_, []).
put_bytes(Stream, [Byte|Bytes]) :-
put_byte(Stream, Byte),
put_bytes(Stream, Bytes).
pipe_bytes(StreamIn, StreamOut) :-
get_byte(StreamIn, Byte),
(
Byte =\= -1 ->
(
put_byte(StreamOut, Byte),
pipe_bytes(StreamIn, StreamOut)
)
; true).
% WARNING: This only works for ASCII chars. This code can be modified to support
% Latin1 characters also but a completely different approach is needed for other
% languages. Since HTTP internals are ASCII, this is fine for this usecase.
chars_lower(Chars, Lower) :-
maplist(char_lower, Chars, Lower).
char_lower(Char, Lower) :-
char_code(Char, Code),
((Code >= 65,Code =< 90) ->
LowerCode is Code + 32,
char_code(Lower, LowerCode)
; Char = Lower).
% Decodes a UTF-8 URL Encoded string: RFC-1738
url_decode([Char|Chars]) -->
[Char],

63
src/lib/iso_ext.pl
View File

@@ -1,8 +1,3 @@
%% for builtins that are not part of the ISO standard.
%% must be loaded at the REPL with
%% ?- use_module(library(iso_ext)).
:- module(iso_ext, [bb_b_put/2,
bb_get/2,
bb_put/2,
@@ -14,8 +9,9 @@
partial_string_tail/2,
setup_call_cleanup/3,
call_nth/2,
% variant/2,
copy_term_nat/2]).
copy_term_nat/2,
asserta/2,
assertz/2]).
:- use_module(library(error), [can_be/2,
domain_error/3,
@@ -64,7 +60,7 @@ call_cleanup(G, C) :- setup_call_cleanup(true, G, C).
setup_call_cleanup(S, G, C) :-
'$get_b_value'(B),
'$call_with_inference_counting'('$call'(S)),
'$call_with_inference_counting'(call(S)),
'$set_cp_by_default'(B),
'$get_current_block'(Bb),
( C = _:CC,
@@ -80,20 +76,20 @@ setup_call_cleanup(S, G, C) :-
scc_helper(C, G, Bb) :-
'$get_cp'(Cp),
'$install_scc_cleaner'(C, NBb),
'$call_with_inference_counting'('$call'(G)),
( '$check_cp'(Cp) ->
'$reset_block'(Bb),
run_cleaners_without_handling(Cp)
; true
; '$reset_block'(NBb),
'$fail'
'$call_with_inference_counting'(call(G)),
( '$check_cp'(Cp) ->
'$reset_block'(Bb),
run_cleaners_without_handling(Cp)
; true
; '$reset_block'(NBb),
'$fail'
).
scc_helper(_, _, Bb) :-
'$reset_block'(Bb),
'$get_ball'(Ball),
'$erase_ball',
'$push_ball_stack',
run_cleaners_with_handling,
throw(Ball).
'$pop_from_ball_stack',
'$unwind_stack'.
scc_helper(_, _, _) :-
'$get_cp'(Cp),
run_cleaners_without_handling(Cp),
@@ -115,7 +111,7 @@ run_cleaners_with_handling :-
run_cleaners_without_handling(Cp) :-
'$get_scc_cleaner'(C),
'$get_level'(B),
'$call'(C),
call(C),
'$set_cp_by_default'(B),
run_cleaners_without_handling(Cp).
run_cleaners_without_handling(Cp) :-
@@ -136,10 +132,13 @@ end_block(B, _Bb, NBb, L) :-
:- non_counted_backtracking handle_ile/3.
handle_ile(B, inference_limit_exceeded(B), inference_limit_exceeded) :- !.
handle_ile(B, E, _) :-
handle_ile(B, inference_limit_exceeded(B), inference_limit_exceeded) :-
!,
'$pop_ball_stack'.
handle_ile(B, _, _) :-
'$remove_call_policy_check'(B),
throw(E).
'$pop_from_ball_stack',
'$unwind_stack'.
:- meta_predicate(call_with_inference_limit(0, ?, ?)).
@@ -170,21 +169,21 @@ install_inference_counter(B, L, Count0) :-
call_with_inference_limit(G, L, R, Bb, B) :-
'$install_new_block'(NBb),
'$install_inference_counter'(B, L, Count0),
'$call_with_inference_counting'('$call'(G)),
'$call_with_inference_counting'(call(G)),
'$inference_level'(R, B),
'$remove_inference_counter'(B, Count1),
is(Diff, L - (Count1 - Count0)),
Diff is L - (Count1 - Count0),
end_block(B, Bb, NBb, Diff).
call_with_inference_limit(_, _, R, Bb, B) :-
'$reset_block'(Bb),
'$remove_inference_counter'(B, _),
( '$get_ball'(Ball),
'$push_ball_stack',
'$get_level'(Cp),
'$set_cp_by_default'(Cp)
; '$remove_call_policy_check'(B),
'$fail'
),
'$erase_ball',
handle_ile(B, Ball, R).
partial_string(String, L, L0) :-
@@ -250,3 +249,17 @@ call_nth_nesting(C, ID) :-
copy_term_nat(Source, Dest) :-
'$copy_term_without_attr_vars'(Source, Dest).
asserta(Module, (Head :- Body)) :-
!,
'$asserta'(Module, Head, Body).
asserta(Module, Fact) :-
'$asserta'(Module, Fact, true).
assertz(Module, (Head :- Body)) :-
!,
'$assertz'(Module, Head, Body).
assertz(Module, Fact) :-
'$assertz'(Module, Fact, true).

93
src/lib/lists.pl
View File

@@ -1,7 +1,7 @@
:- module(lists, [member/2, select/3, append/2, append/3, foldl/4, foldl/5,
memberchk/2, reverse/2, length/2, maplist/2,
maplist/3, maplist/4, maplist/5, maplist/6,
maplist/7, maplist/8, maplist/9, same_length/2, nth0/3,
maplist/7, maplist/8, maplist/9, same_length/2, nth0/3, nth0/4, nth1/3, nth1/4,
sum_list/2, transpose/2, list_to_set/2, list_max/2,
list_min/2, permutation/2]).
@@ -243,27 +243,82 @@ unify_same(E-V, Prev-Var, E-V) :-
).
nth0(N, Es, E) :-
can_be(integer, N),
can_be(list, Es),
( integer(N) ->
nth0_index(N, Es, E)
; nth0_search(N, Es, E)
).
nth0(N, Es0, E) :-
nonvar(N),
'$skip_max_list'(Skip, N, Es0,Es1),
!,
( Skip == N
-> Es1 = [E|_]
; ( var(Es1) ; Es1 = [_|_] ) % a partial or infinite list
-> R is N-Skip,
skipn(R,Es1,Es2),
Es2 = [E|_]
).
nth0(N, Es0, E) :-
can_be(not_less_than_zero, N),
Es0 = [E0|Es1],
nth0_el(0,N, E0,E, Es1).
nth0_index(0, [E|_], E) :- !.
nth0_index(N, [_|Es], E) :-
N > 0,
N1 is N - 1,
nth0_index(N1, Es, E).
skipn(N0, Es0,Es) :-
N0>0,
!, % should not be necessary #1028
N1 is N0-1,
Es0 = [_|Es1],
skipn(N1, Es1,Es).
skipn(0, Es,Es).
nth0_search(N, Es, E) :-
nth0_search(0, N, Es, E).
nth0_el(N0,N, E0,E, Es0) :-
Es0 == [],
!, % indexing
N0 = N,
E0 = E.
nth0_el(N,N, E,E, _).
nth0_el(N0,N, _,E, [E0|Es0]) :-
N1 is N0+1,
nth0_el(N1,N, E0,E, Es0).
nth0_search(N, N, [E|_], E).
nth0_search(N0, N, [_|Es], E) :-
N1 is N0 + 1,
nth0_search(N1, N, Es, E).
nth1(N, Es0, E) :-
N \== 0,
nth0(N, [_|Es0], E),
N \== 0.
skipn(N0, Es0,Es, Xs0,Xs) :-
N0>0,
!, % should not be necessary #1028
N1 is N0-1,
Es0 = [E|Es1],
Xs0 = [E|Xs1],
skipn(N1, Es1,Es, Xs1,Xs).
skipn(0, Es,Es, Xs,Xs).
nth0(N, Es0, E, Es) :-
integer(N),
N >= 0,
!,
skipn(N, Es0,Es1, Es,Es2),
Es1 = [E|Es2].
nth0(N, Es0, E, Es) :-
can_be(not_less_than_zero, N),
Es0 = [E0|Es1],
nth0_elx(0,N, E0,E, Es1, Es).
nth0_elx(N0,N, E0,E, Es0, Es) :-
Es0 == [],
!,
N0 = N,
E0 = E,
Es0 = Es.
nth0_elx(N,N, E,E, Es, Es).
nth0_elx(N0,N, E0,E, [E1|Es0], [E0|Es]) :-
N1 is N0+1,
nth0_elx(N1,N, E1,E, Es0, Es).
% p.p.8.5
nth1(N, Es0, E, Es) :-
N \== 0,
nth0(N, [_|Es0], E, [_|Es]),
N \== 0.
list_max([N|Ns], Max) :-

2
src/lib/pairs.pl
View File

@@ -5,7 +5,7 @@
map_list_to_pairs/3]).
:- meta_predicate map_list_to_pairs(0, ?, ?).
:- meta_predicate map_list_to_pairs(2, ?, ?).
pairs_keys_values([], [], []).
pairs_keys_values([A-B|ABs], [A|As], [B|Bs]) :-

9
src/lib/pio.pl
View File

@@ -4,9 +4,9 @@
Our goal is to encourage the use of definite clause grammars (DCGs)
for describing strings. The predicates phrase_from_file/[2,3],
phrase_to_file/2 and phrase_to_stream/2 let us apply DCGs transparently
to files and streams, and therefore decouple side-effects from
declarative descriptions.
phrase_to_file/[2,3] and phrase_to_stream/2 let us apply DCGs
transparently to files and streams, and therefore decouple side-effects
from declarative descriptions.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
:- module(pio, [phrase_from_file/2,
@@ -26,6 +26,7 @@
:- meta_predicate(phrase_from_file(2, ?)).
:- meta_predicate(phrase_from_file(2, ?, ?)).
:- meta_predicate(phrase_to_file(2, ?)).
:- meta_predicate(phrase_to_file(2, ?, ?)).
:- meta_predicate(phrase_to_stream(2, ?)).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -90,7 +91,7 @@ phrase_to_stream(GRBody, Stream) :-
must_be(chars, Cs),
( stream_property(Stream, type(binary)) ->
( '$first_non_octet'(Cs, N) ->
domain_error(byte_char, N, phrase_to_stream/2)
domain_error(octet_character, N, phrase_to_stream/2)
; true
)
; true

13
src/lib/reif.pl
View File

@@ -1,6 +1,6 @@
:- module(reif, [if_/3, (=)/3, (',')/3, (;)/3, cond_t/3, dif/3,
memberd_t/3, tfilter/3, tmember/2, tmember_t/3,
tpartition/4]).
memberd_t/3, tfilter/3, tmember/2, tmember_t/3,
tpartition/4]).
:- use_module(library(dif)).
@@ -30,13 +30,10 @@ non(false, true).
:- meta_predicate(tfilter(2, ?, ?)).
tfilter(C_2, Es, Fs) :-
i_tfilter(Es, C_2, Fs).
i_tfilter([], _, []).
i_tfilter([E|Es], C_2, Fs0) :-
tfilter(_, [], []).
tfilter(C_2, [E|Es], Fs0) :-
if_(call(C_2, E), Fs0 = [E|Fs], Fs0 = Fs),
i_tfilter(Es, C_2, Fs).
tfilter(C_2, Es, Fs).
:- meta_predicate(tpartition(2, ?, ?, ?)).

19
src/lib/si.pl
View File

@@ -27,7 +27,8 @@
:- module(si, [atom_si/1,
integer_si/1,
atomic_si/1,
list_si/1]).
list_si/1,
chars_si/1]).
:- use_module(library(lists)).
@@ -42,6 +43,16 @@ integer_si(I) :-
atomic_si(AC) :-
functor(AC,_,0).
list_si(L) :-
\+ \+ length(L, _),
sort(L, _).
% list_si(L) :-
% \+ \+ length(L, _),
% sort(L, _).
list_si(L0) :-
'$skip_max_list'(_,_, L0,L),
( nonvar(L) -> L = []
; throw(error(instantiation_error, list_si/1))
).
chars_si(Cs) :-
list_si(Cs),
'$is_partial_string'(Cs).

4
src/lib/simplex.pl
View File

@@ -1344,10 +1344,6 @@ print_row(R) :- maplist(print_row_, R), nl.
print_row_(N) :- format("~w ", [N]).
nth1(N, Es, E) :-
N1 is N - 1,
nth0(N1, Es, E).
%?- transportation([1,1], [1,1], [[1,1],[1,1]], Ms).
%?- transportation([12,7,14], [3,15,9,6], [[20,50,10,60],[70,40,60,30],[40,80,70,40]], Ms).

2
src/lib/tabling.pl
View File

@@ -67,7 +67,7 @@ table_and_status_for_variant(V,T,S) :-
tbd_table_status(T,S).
:- meta_predicate start_tabling(?, 0).
:- meta_predicate start_tabling(?, :).
start_tabling(Wrapper,Worker) :-
put_new_trie_table_link,

4
src/lib/terms.pl
View File

@@ -4,8 +4,8 @@
numbervars(Term, N0, N) :-
catch(internal_numbervars(Term, N0, N),
error(E,Ctx),
( ( var(Ctx) -> Ctx = numbervars/3 ; true ), throw(error(E,Ctx) ) ) ).
error(E,Ctx),
( ( var(Ctx) -> Ctx = numbervars/3 ; true ), throw(error(E,Ctx) ) ) ).
internal_numbervars(Term, N0, N) :-
must_be(integer, N0),

12
src/lib/xpath.pl
View File

@@ -26,22 +26,22 @@
:- use_module(library(http/http_open)).
:- use_module(library(sgml)).
:- use_module(library(lists)).
:- use_module(library(xpath)).
:- use_module(library(dcgs)).
link_to_pl_file(File) :-
http_open("https://github.com/mthom/scryer-prolog", S, []),
load_html(stream(S), DOM, []),
xpath(DOM, //a(@href), File),
append(_, ".pl", File).
phrase((...,".pl"), File).
Yielding:
?- link_to_pl_file(File).
%@ File = "/mthom/scryer-prolog/blob/master/src/lib/tabling.pl"
%@ ; File = "/mthom/scryer-prolog/blob/master/src/lib/dif.pl"
%@ ; File = "/mthom/scryer-prolog/blob/master/src/lib/freeze.pl"
%@ ; ...
%@ File = "/mthom/scryer-prolog/blob/master/src/lib/dcgs.pl"
%@ ; File = "/mthom/scryer-prolog/blob/master/src/lib/pio.pl"
%@ ; File = "/mthom/scryer-prolog/blob/master/src/lib/tabling.pl"
%@ ; ... .
Parts of the original functionality may not yet work. Please
consider such parts opportunities for improvements, and file

1771
src/loader.pl
View File

File diff suppressed because it is too large Load Diff

3
src/machine/arithmetic_ops.rs
View File

@@ -390,7 +390,6 @@ pub(crate) fn int_pow(n1: Number, n2: Number, arena: &mut Arena) -> Result<Numbe
pub(crate) fn pow(n1: Number, n2: Number, culprit: Atom) -> Result<Number, MachineStubGen> {
if n2.is_negative() && n1.is_zero() {
let stub_gen = move || functor_stub(culprit, 2);
return Err(undefined_eval_error(stub_gen));
}
@@ -1183,7 +1182,7 @@ impl MachineState {
let result = arena_alloc!(
drop_iter_on_err!(self, iter, rdiv(r1, r2)),
self.arena
&mut self.arena
);
self.interms.push(Number::Rational(result));

6
src/machine/attributed_variables.pl
View File

@@ -28,11 +28,13 @@ call_verify_attributes([Attr|Attrs], Var, Value, ListOfGoalLists) :-
sort(Modules0, Modules),
verify_attrs(Modules, Var, Value, ListOfGoalLists).
error_handler(M, evaluation_error((M:verify_attributes)/3), []).
% error_handler(_, existence_error(procedure, verify_attributes/3), []).
verify_attrs([Module|Modules], Var, Value, [Module-Goals|ListOfGoalLists]) :-
catch(Module:verify_attributes(Var, Value, Goals),
error(evaluation_error((Module:verify_attributes)/3), verify_attributes/3),
Goals = []),
error(E, verify_attributes/3),
error_handler(Module, E, Goals)),
verify_attrs(Modules, Var, Value, ListOfGoalLists).
verify_attrs([], _, _, []).

91
src/machine/compile.rs
View File

@@ -406,7 +406,7 @@ fn merge_indexed_subsequences(
*o = 0;
return Some(IndexPtr::Index(outer_threaded_choice_instr_loc + 1));
return Some(IndexPtr::index(outer_threaded_choice_instr_loc + 1));
}
_ => {}
},
@@ -785,7 +785,7 @@ fn remove_non_leading_clause(
*o = 0;
Some(IndexPtr::Index(preceding_choice_instr_loc + 1))
Some(IndexPtr::index(preceding_choice_instr_loc + 1))
}
_ => {
unreachable!();
@@ -820,7 +820,7 @@ fn finalize_retract(
retraction_info,
&compilation_target,
key,
&code_index,
code_index,
index_ptr,
);
}
@@ -849,9 +849,9 @@ fn remove_leading_unindexed_clause(
retraction_info,
);
Some(IndexPtr::Index(index_ptr))
Some(IndexPtr::index(index_ptr))
} else {
Some(IndexPtr::DynamicUndefined)
Some(IndexPtr::dynamic_undefined())
}
}
_ => {
@@ -1131,9 +1131,9 @@ fn prepend_compiled_clause(
};
if skeleton.core.is_dynamic {
IndexPtr::DynamicIndex(clause_loc)
IndexPtr::dynamic_index(clause_loc)
} else {
IndexPtr::Index(clause_loc)
IndexPtr::index(clause_loc)
}
}
@@ -1268,9 +1268,9 @@ fn append_compiled_clause(
code_ptr_opt.map(|p| {
if skeleton.core.is_dynamic {
IndexPtr::DynamicIndex(p)
IndexPtr::dynamic_index(p)
} else {
IndexPtr::Index(p)
IndexPtr::index(p)
}
})
}
@@ -1306,8 +1306,8 @@ fn print_overwrite_warning(
}
}
match code_ptr {
IndexPtr::DynamicUndefined | IndexPtr::Undefined => return,
match code_ptr.tag() {
IndexPtrTag::DynamicUndefined | IndexPtrTag::Undefined => return,
_ if is_dynamic => return,
_ => {}
}
@@ -1471,16 +1471,16 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
);
let index_ptr = if settings.is_dynamic() {
IndexPtr::DynamicIndex(code_ptr)
IndexPtr::dynamic_index(code_ptr)
} else {
IndexPtr::Index(code_ptr)
IndexPtr::index(code_ptr)
};
set_code_index(
&mut self.payload.retraction_info,
&predicates.compilation_target,
key,
&code_index,
code_index,
index_ptr,
);
@@ -1704,7 +1704,7 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
&mut self.payload.retraction_info,
&compilation_target,
key,
&code_index,
code_index,
new_code_ptr,
);
}
@@ -1745,7 +1745,7 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
&mut self.payload.retraction_info,
&compilation_target,
key,
&code_index,
code_index,
new_code_ptr,
);
@@ -1870,7 +1870,7 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
skeleton.clauses[target_pos].clause_start;
let index_ptr_opt = if target_pos == 0 {
Some(IndexPtr::Index(clause_loc))
Some(IndexPtr::index(clause_loc))
} else {
None
};
@@ -2384,13 +2384,15 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
match self.wam_prelude.indices.modules.get_mut(&filename) {
Some(ref mut module) => {
let index_ptr = code_index.get();
let code_index = module.code_dir.entry(key).or_insert(code_index);
let code_index = module.code_dir.entry(key)
.or_insert(code_index)
.clone();
set_code_index(
&mut self.payload.retraction_info,
&CompilationTarget::Module(filename),
key,
&code_index,
code_index,
index_ptr,
);
}
@@ -2418,3 +2420,54 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
Ok(())
}
}
// standalone functions for compiling auxiliary goals used by expand_goal.
impl Machine {
pub(crate) fn get_or_insert_qualified_code_index(
&mut self,
module_name: HeapCellValue,
key: PredicateKey,
) -> CodeIndex {
let mut loader: Loader<'_, InlineLoadState<'_>> = Loader::new(
self,
InlineTermStream {},
);
let module_name = if module_name.get_tag() == HeapCellValueTag::Atom {
cell_as_atom!(module_name)
} else {
atom!("user")
};
loader.get_or_insert_qualified_code_index(module_name, key)
}
pub(crate) fn compile_standalone_clause(
&mut self,
term_loc: RegType,
vars: &[Term],
) -> Result<(), SessionError> {
let mut compile = || {
let mut loader: Loader<'_, InlineLoadState<'_>> = Loader::new(
self,
InlineTermStream {},
);
let term = loader.read_term_from_heap(term_loc)?;
let clause = build_rule_body(vars, term);
let settings = CodeGenSettings {
global_clock_tick: None,
is_extensible: false,
non_counted_bt: true,
};
loader.compile_standalone_clause(clause, settings)
};
let StandaloneCompileResult { clause_code, .. } = compile()?;
self.code.extend(clause_code.into_iter());
Ok(())
}
}

9
src/machine/copier.rs
View File

@@ -1,4 +1,5 @@
use crate::atom_table::*;
use crate::machine::get_structure_index;
use crate::machine::stack::*;
use crate::types::*;
@@ -248,6 +249,14 @@ impl<T: CopierTarget> CopyTermState<T> {
let hcv = self.target[addr + 1 + i];
self.target.push(hcv);
}
let index_cell = self.target[addr + 1 + arity];
if get_structure_index(index_cell).is_some() {
// copy the index pointer trailing this
// inlined or expanded goal.
self.target.push(index_cell);
}
}
(HeapCellValueTag::Str, h) => {
*self.value_at_scan() = str_loc_as_cell!(h);

261
src/machine/dispatch.rs
View File

@@ -57,18 +57,28 @@ impl MachineState {
let a2 = self.registers[2];
let a3 = self.registers[3];
let check_atom = |machine_st: &mut MachineState, name: Atom, arity: usize| -> Result<(), MachineStub> {
match name {
atom!(">") | atom!("<") | atom!("=") if arity == 0 => {
Ok(())
}
_ => {
let err = machine_st.domain_error(DomainErrorType::Order, a1);
Err(machine_st.error_form(err, stub_gen()))
}
}
};
read_heap_cell!(a1,
(HeapCellValueTag::Atom, (name, arity)) => {
debug_assert_eq!(arity, 0);
check_atom(self, name, arity)?;
}
(HeapCellValueTag::Str, s) => {
let (name, arity) = cell_as_atom_cell!(self.heap[s])
.get_name_and_arity();
match name {
atom!(">") | atom!("<") | atom!("=") => {
}
_ => {
let err = self.domain_error(DomainErrorType::Order, a1);
return Err(self.error_form(err, stub_gen()));
}
}
check_atom(self, name, arity)?;
}
(HeapCellValueTag::AttrVar | HeapCellValueTag::Var | HeapCellValueTag::StackVar) => {
}
@@ -360,8 +370,15 @@ impl Machine {
debug_assert!(arity == 0);
c
}
(HeapCellValueTag::Str) => {
s
(HeapCellValueTag::Str, st) => {
let (name, arity) = cell_as_atom_cell!(self.machine_st.heap[st])
.get_name_and_arity();
match (name, arity) {
(atom!("."), 2) => l,
(_, 0) => c,
_ => s,
}
}
(HeapCellValueTag::Cons, ptr) => {
match ptr.get_tag() {
@@ -421,6 +438,9 @@ impl Machine {
debug_assert_eq!(arity, 0);
Literal::Atom(atom)
}
(HeapCellValueTag::Str, s) => {
Literal::Atom(cell_as_atom_cell!(self.machine_st.heap[s]).get_name())
}
(HeapCellValueTag::Cons, cons_ptr) => {
match_untyped_arena_ptr!(cons_ptr,
(ArenaHeaderTag::Rational, r) => {
@@ -597,6 +617,7 @@ impl Machine {
&mut self.machine_st,
try_numeric_result!(sub(n1, n2, &mut self.machine_st.arena), stub_gen)
);
self.machine_st.p += 1;
}
&Instruction::Mul(ref a1, ref a2, t) => {
@@ -675,7 +696,7 @@ impl Machine {
self.machine_st.interms[t - 1] = Number::Rational(arena_alloc!(
try_or_throw_gen!(&mut self.machine_st, rdiv(r1, r2)),
self.machine_st.arena
&mut self.machine_st.arena
));
self.machine_st.p += 1;
@@ -688,6 +709,7 @@ impl Machine {
&mut self.machine_st,
int_floor_div(n1, n2, &mut self.machine_st.arena)
);
self.machine_st.p += 1;
}
&Instruction::IDiv(ref a1, ref a2, t) => {
@@ -698,6 +720,7 @@ impl Machine {
&mut self.machine_st,
idiv(n1, n2, &mut self.machine_st.arena)
);
self.machine_st.p += 1;
}
&Instruction::Abs(ref a1, t) => {
@@ -1122,17 +1145,7 @@ impl Machine {
);
}
&Instruction::NeckCut => {
let b = self.machine_st.b;
let b0 = self.machine_st.b0;
if b > b0 {
self.machine_st.b = b0;
if b > self.machine_st.e {
self.machine_st.stack.truncate(b);
}
}
self.machine_st.neck_cut();
self.machine_st.p += 1;
}
&Instruction::GetLevel(r) => {
@@ -1298,7 +1311,6 @@ impl Machine {
}
&Instruction::DefaultCallRead(_) => {
try_or_throw!(self.machine_st, self.read());
step_or_fail!(self, self.machine_st.p += 1);
}
&Instruction::DefaultExecuteRead(_) => {
@@ -2354,6 +2366,16 @@ impl Machine {
self.machine_st.backtrack();
}
}
(HeapCellValueTag::Str, s) => {
let arity = cell_as_atom_cell!(self.machine_st.heap[s])
.get_arity();
if arity == 0 {
self.machine_st.p += 1;
} else {
self.machine_st.backtrack();
}
}
(HeapCellValueTag::Char) => {
self.machine_st.p += 1;
}
@@ -2373,6 +2395,16 @@ impl Machine {
self.machine_st.backtrack();
}
}
(HeapCellValueTag::Str, s) => {
let arity = cell_as_atom_cell!(self.machine_st.heap[s])
.get_arity();
if arity == 0 {
self.machine_st.p = self.machine_st.cp;
} else {
self.machine_st.backtrack();
}
}
(HeapCellValueTag::Char) => {
self.machine_st.p = self.machine_st.cp;
}
@@ -2396,6 +2428,16 @@ impl Machine {
self.machine_st.backtrack();
}
}
(HeapCellValueTag::Str, s) => {
let arity = cell_as_atom_cell!(self.machine_st.heap[s])
.get_arity();
if arity == 0 {
self.machine_st.p += 1;
} else {
self.machine_st.backtrack();
}
}
_ => {
self.machine_st.backtrack();
}
@@ -2416,6 +2458,16 @@ impl Machine {
self.machine_st.backtrack();
}
}
(HeapCellValueTag::Str, s) => {
let arity = cell_as_atom_cell!(self.machine_st.heap[s])
.get_arity();
if arity == 0 {
self.machine_st.p = self.machine_st.cp;
} else {
self.machine_st.backtrack();
}
}
_ => {
self.machine_st.backtrack();
}
@@ -2425,10 +2477,21 @@ impl Machine {
let d = self.machine_st.store(self.machine_st.deref(self.machine_st[r]));
read_heap_cell!(d,
(HeapCellValueTag::Str | HeapCellValueTag::Lis |
HeapCellValueTag::PStrLoc | HeapCellValueTag::CStr) => {
(HeapCellValueTag::Lis |
HeapCellValueTag::PStrLoc |
HeapCellValueTag::CStr) => {
self.machine_st.p += 1;
}
(HeapCellValueTag::Str, s) => {
let arity = cell_as_atom_cell!(self.machine_st.heap[s])
.get_arity();
if arity > 0 {
self.machine_st.p += 1;
} else {
self.machine_st.backtrack();
}
}
(HeapCellValueTag::Atom, (_name, arity)) => {
if arity > 0 {
self.machine_st.p += 1;
@@ -2445,10 +2508,21 @@ impl Machine {
let d = self.machine_st.store(self.machine_st.deref(self.machine_st[r]));
read_heap_cell!(d,
(HeapCellValueTag::Str | HeapCellValueTag::Lis |
HeapCellValueTag::PStrLoc | HeapCellValueTag::CStr) => {
(HeapCellValueTag::Lis |
HeapCellValueTag::PStrLoc |
HeapCellValueTag::CStr) => {
self.machine_st.p = self.machine_st.cp;
}
(HeapCellValueTag::Str, s) => {
let arity = cell_as_atom_cell!(self.machine_st.heap[s])
.get_arity();
if arity > 0 {
self.machine_st.p = self.machine_st.cp;
} else {
self.machine_st.backtrack();
}
}
(HeapCellValueTag::Atom, (_name, arity)) => {
if arity > 0 {
self.machine_st.p = self.machine_st.cp;
@@ -2744,6 +2818,19 @@ impl Machine {
self.machine_st.s_offset = 0;
self.machine_st.mode = MachineMode::Read;
}
(HeapCellValueTag::Str, s) => {
let (name, arity) = cell_as_atom_cell!(self.machine_st.heap[s])
.get_name_and_arity();
if name == atom!(".") && arity == 2 {
self.machine_st.s = HeapPtr::HeapCell(s+1);
self.machine_st.s_offset = 0;
self.machine_st.mode = MachineMode::Read;
} else {
self.machine_st.backtrack();
continue;
}
}
(HeapCellValueTag::Lis, l) => {
self.machine_st.s = HeapPtr::HeapCell(l);
self.machine_st.s_offset = 0;
@@ -3500,7 +3587,10 @@ impl Machine {
self.dynamic_module_resolution(arity - 2)
);
try_or_throw!(self.machine_st, self.call_clause(module_name, key));
try_or_throw!(
self.machine_st,
self.call_clause(module_name, key)
);
if self.machine_st.fail {
self.machine_st.backtrack();
@@ -3512,7 +3602,10 @@ impl Machine {
self.dynamic_module_resolution(arity - 2)
);
try_or_throw!(self.machine_st, self.execute_clause(module_name, key));
try_or_throw!(
self.machine_st,
self.execute_clause(module_name, key)
);
if self.machine_st.fail {
self.machine_st.backtrack();
@@ -4032,14 +4125,6 @@ impl Machine {
self.clean_up_block();
self.machine_st.p = self.machine_st.cp;
}
&Instruction::CallEraseBall(_) => {
self.erase_ball();
self.machine_st.p += 1;
}
&Instruction::ExecuteEraseBall(_) => {
self.erase_ball();
self.machine_st.p = self.machine_st.cp;
}
&Instruction::CallFail(_) | &Instruction::ExecuteFail(_) => {
self.machine_st.backtrack();
}
@@ -4123,6 +4208,30 @@ impl Machine {
try_or_throw!(self.machine_st, self.http_open());
step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
}
&Instruction::CallHttpListen(_) => {
try_or_throw!(self.machine_st, self.http_listen());
step_or_fail!(self, self.machine_st.p += 1);
}
&Instruction::ExecuteHttpListen(_) => {
try_or_throw!(self.machine_st, self.http_listen());
step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
}
&Instruction::CallHttpAccept(_) => {
try_or_throw!(self.machine_st, self.http_accept());
step_or_fail!(self, self.machine_st.p += 1);
}
&Instruction::ExecuteHttpAccept(_) => {
try_or_throw!(self.machine_st, self.http_accept());
step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
}
&Instruction::CallHttpAnswer(_) => {
try_or_throw!(self.machine_st, self.http_answer());
step_or_fail!(self, self.machine_st.p += 1);
}
&Instruction::ExecuteHttpAnswer(_) => {
try_or_throw!(self.machine_st, self.http_answer());
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);
@@ -4167,6 +4276,30 @@ impl Machine {
self.set_ball();
self.machine_st.p = self.machine_st.cp;
}
&Instruction::CallPushBallStack(_) => {
self.push_ball_stack();
step_or_fail!(self, self.machine_st.p += 1);
}
&Instruction::ExecutePushBallStack(_) => {
self.push_ball_stack();
step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
}
&Instruction::CallPopBallStack(_) => {
self.pop_ball_stack();
self.machine_st.p += 1;
}
&Instruction::ExecutePopBallStack(_) => {
self.pop_ball_stack();
self.machine_st.p = self.machine_st.cp;
}
&Instruction::CallPopFromBallStack(_) => {
self.pop_from_ball_stack();
self.machine_st.p += 1;
}
&Instruction::ExecutePopFromBallStack(_) => {
self.pop_from_ball_stack();
self.machine_st.p = self.machine_st.cp;
}
&Instruction::CallSetCutPointByDefault(r, _) => {
self.set_cut_point_by_default(r);
step_or_fail!(self, self.machine_st.p += 1);
@@ -4853,11 +4986,11 @@ impl Machine {
}
&Instruction::CallPredicateDefined(_) => {
self.machine_st.fail = !self.predicate_defined();
self.machine_st.p += 1;
step_or_fail!(self, self.machine_st.p += 1);
}
&Instruction::ExecutePredicateDefined(_) => {
self.machine_st.fail = !self.predicate_defined();
self.machine_st.p = self.machine_st.cp;
step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
}
&Instruction::CallStripModule(_) => {
let (module_loc, qualified_goal) = self.machine_st.strip_module(
@@ -4886,7 +5019,7 @@ impl Machine {
&Instruction::ExecuteStripModule(_) => {
let (module_loc, qualified_goal) = self.machine_st.strip_module(
self.machine_st.registers[1],
self.machine_st.registers[2]
self.machine_st.registers[2],
);
let target_module_loc = self.machine_st.registers[2];
@@ -4915,6 +5048,54 @@ impl Machine {
try_or_throw!(self.machine_st, self.prepare_call_clause(arity));
step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
}
&Instruction::CallCompileInlineOrExpandedGoal(_) => {
try_or_throw!(self.machine_st, self.compile_inline_or_expanded_goal());
step_or_fail!(self, self.machine_st.p += 1);
}
&Instruction::ExecuteCompileInlineOrExpandedGoal(_) => {
try_or_throw!(self.machine_st, self.compile_inline_or_expanded_goal());
step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
}
&Instruction::CallIsExpandedOrInlined(_) => {
self.machine_st.fail = !self.is_expanded_or_inlined();
step_or_fail!(self, self.machine_st.p += 1);
}
&Instruction::ExecuteIsExpandedOrInlined(_) => {
self.machine_st.fail = !self.is_expanded_or_inlined();
step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
}
&Instruction::CallInlineCallN(arity, _) => {
let call_at_index = |wam: &mut Machine, name, arity, ptr| {
wam.try_call(name, arity, ptr)
};
try_or_throw!(self.machine_st, self.call_inline(arity, call_at_index));
if self.machine_st.fail {
self.machine_st.backtrack();
} else {
try_or_throw!(
self.machine_st,
(self.machine_st.increment_call_count_fn)(&mut self.machine_st)
);
}
}
&Instruction::ExecuteInlineCallN(arity, _) => {
let call_at_index = |wam: &mut Machine, name, arity, ptr| {
wam.try_execute(name, arity, ptr)
};
try_or_throw!(self.machine_st, self.call_inline(arity, call_at_index));
if self.machine_st.fail {
self.machine_st.backtrack();
} else {
try_or_throw!(
self.machine_st,
(self.machine_st.increment_call_count_fn)(&mut self.machine_st)
);
}
}
}
}

11
src/machine/gc.rs
View File

@@ -2,6 +2,9 @@ use crate::atom_table::*;
use crate::machine::heap::*;
use crate::types::*;
#[cfg(test)]
use crate::heap_iter::FocusedHeapIter;
use core::marker::PhantomData;
pub(crate) trait UnmarkPolicy {
@@ -69,6 +72,14 @@ pub(crate) struct StacklessPreOrderHeapIter<'a, UMP: UnmarkPolicy> {
_marker: PhantomData<UMP>,
}
#[cfg(test)]
impl<'a> FocusedHeapIter for StacklessPreOrderHeapIter<'a, IteratorUMP> {
#[inline]
fn focus(&self) -> usize {
self.current
}
}
impl<'a, UMP: UnmarkPolicy> Drop for StacklessPreOrderHeapIter<'a, UMP> {
fn drop(&mut self) {
if self.current == self.start {

7
src/machine/heap.rs
View File

@@ -1,6 +1,7 @@
use crate::arena::*;
use crate::atom_table::*;
use crate::forms::*;
use crate::machine::machine_indices::*;
use crate::machine::partial_string::*;
use crate::parser::ast::*;
use crate::types::*;
@@ -17,6 +18,9 @@ impl From<Literal> for HeapCellValue {
match literal {
Literal::Atom(name) => atom_as_cell!(name),
Literal::Char(c) => char_as_cell!(c),
Literal::CodeIndex(ptr) => {
untyped_arena_ptr_as_cell!(UntypedArenaPtr::from(ptr))
}
Literal::Fixnum(n) => fixnum_as_cell!(n),
Literal::Integer(bigint_ptr) => {
typed_arena_ptr_as_cell!(bigint_ptr)
@@ -65,6 +69,9 @@ impl TryFrom<HeapCellValue> for Literal {
(ArenaHeaderTag::Rational, n) => {
Ok(Literal::Rational(n))
}
(ArenaHeaderTag::IndexPtr, _ip) => {
Ok(Literal::CodeIndex(CodeIndex::from(cons_ptr)))
}
_ => {
Err(())
}

217
src/machine/load_state.rs
View File

@@ -21,12 +21,12 @@ pub(super) fn set_code_index(
retraction_info: &mut RetractionInfo,
compilation_target: &CompilationTarget,
key: PredicateKey,
code_index: &CodeIndex,
mut code_index: CodeIndex,
code_ptr: IndexPtr,
) {
let record = match compilation_target {
CompilationTarget::User => {
if IndexPtr::Undefined == code_index.get() {
if IndexPtrTag::Undefined == code_index.get().tag() {
code_index.set(code_ptr);
RetractionRecord::AddedUserPredicate(key)
} else {
@@ -35,7 +35,7 @@ pub(super) fn set_code_index(
}
}
CompilationTarget::Module(ref module_name) => {
if IndexPtr::Undefined == code_index.get() {
if IndexPtrTag::Undefined == code_index.get().tag() {
code_index.set(code_ptr);
RetractionRecord::AddedModulePredicate(*module_name, key)
} else {
@@ -48,12 +48,10 @@ pub(super) fn set_code_index(
retraction_info.push_record(record);
}
fn add_op_decl_as_module_export(
fn add_op_decl_as_module_export<'a, LS: LoadState<'a>>(
payload: &mut LS::LoaderFieldType,
module_op_dir: &mut OpDir,
compilation_target: &CompilationTarget,
retraction_info: &mut RetractionInfo,
wam_op_dir: &mut OpDir,
module_op_exports: &mut ModuleOpExports,
op_decl: &OpDecl,
) {
/*
@@ -65,20 +63,21 @@ fn add_op_decl_as_module_export(
match op_decl.insert_into_op_dir(wam_op_dir) {
Some(op_desc) => {
retraction_info.push_record(RetractionRecord::ReplacedUserOp(
payload.retraction_info.push_record(RetractionRecord::ReplacedUserOp(
*op_decl,
op_desc,
));
module_op_exports.push((*op_decl, Some(op_desc)));
payload.module_op_exports.push((*op_decl, Some(op_desc)));
}
None => {
retraction_info.push_record(RetractionRecord::AddedUserOp(*op_decl));
module_op_exports.push((*op_decl, None));
payload.retraction_info.push_record(RetractionRecord::AddedUserOp(*op_decl));
payload.module_op_exports.push((*op_decl, None));
}
}
add_op_decl(retraction_info, compilation_target, module_op_dir, op_decl);
let compilation_target = payload.compilation_target;
add_op_decl(&mut payload.retraction_info, &compilation_target, module_op_dir, op_decl);
}
pub(super) fn add_op_decl(
@@ -117,8 +116,8 @@ pub(super) fn add_op_decl(
}
}
pub(super) fn import_module_exports(
retraction_info: &mut RetractionInfo,
pub(super) fn import_module_exports<'a, LS: LoadState<'a>>(
payload: &mut LS::LoaderFieldType,
compilation_target: &CompilationTarget,
imported_module: &Module,
code_dir: &mut CodeDir,
@@ -135,16 +134,18 @@ pub(super) fn import_module_exports(
}
if let Some(src_code_index) = imported_module.code_dir.get(&key) {
let arena = &mut LS::machine_st(payload).arena;
let target_code_index = code_dir
.entry(key)
.or_insert_with(|| CodeIndex::new(IndexPtr::Undefined))
.or_insert_with(|| CodeIndex::default(arena))
.clone();
set_code_index(
retraction_info,
&mut payload.retraction_info,
compilation_target,
key,
&target_code_index,
target_code_index,
src_code_index.get(),
);
} else {
@@ -155,7 +156,7 @@ pub(super) fn import_module_exports(
}
}
ModuleExport::OpDecl(ref op_decl) => {
add_op_decl(retraction_info, compilation_target, op_dir, op_decl);
add_op_decl(&mut payload.retraction_info, compilation_target, op_dir, op_decl);
}
}
}
@@ -163,15 +164,14 @@ pub(super) fn import_module_exports(
Ok(())
}
fn import_module_exports_into_module(
retraction_info: &mut RetractionInfo,
fn import_module_exports_into_module<'a, LS: LoadState<'a>>(
payload: &mut LS::LoaderFieldType,
compilation_target: &CompilationTarget,
imported_module: &Module,
code_dir: &mut CodeDir,
op_dir: &mut OpDir,
meta_predicates: &mut MetaPredicateDir,
wam_op_dir: &mut OpDir,
module_op_exports: &mut ModuleOpExports,
) -> Result<(), SessionError> {
for export in imported_module.module_decl.exports.iter() {
match export {
@@ -183,16 +183,18 @@ fn import_module_exports_into_module(
}
if let Some(src_code_index) = imported_module.code_dir.get(&key) {
let arena = &mut LS::machine_st(payload).arena;
let target_code_index = code_dir
.entry(key)
.or_insert_with(|| CodeIndex::new(IndexPtr::Undefined))
.or_insert_with(|| CodeIndex::default(arena))
.clone();
set_code_index(
retraction_info,
&mut payload.retraction_info,
compilation_target,
key,
&target_code_index,
target_code_index,
src_code_index.get(),
);
} else {
@@ -203,12 +205,10 @@ fn import_module_exports_into_module(
}
}
ModuleExport::OpDecl(ref op_decl) => {
add_op_decl_as_module_export(
add_op_decl_as_module_export::<LS>(
payload,
op_dir,
compilation_target,
retraction_info,
wam_op_dir,
module_op_exports,
op_decl,
);
}
@@ -218,14 +218,12 @@ fn import_module_exports_into_module(
Ok(())
}
fn import_qualified_module_exports(
retraction_info: &mut RetractionInfo,
fn import_qualified_module_exports<'a, LS: LoadState<'a>>(
payload: &mut LS::LoaderFieldType,
compilation_target: &CompilationTarget,
imported_module: &Module,
exports: &IndexSet<ModuleExport>,
code_dir: &mut CodeDir,
op_dir: &mut OpDir,
meta_predicates: &mut MetaPredicateDir,
wam_prelude: &mut MachinePreludeView,
) -> Result<(), SessionError> {
for export in imported_module.module_decl.exports.iter() {
if !exports.contains(export) {
@@ -237,20 +235,22 @@ fn import_qualified_module_exports(
let key = (*name, *arity);
if let Some(meta_specs) = imported_module.meta_predicates.get(&key) {
meta_predicates.insert(key.clone(), meta_specs.clone());
wam_prelude.indices.meta_predicates.insert(key.clone(), meta_specs.clone());
}
if let Some(src_code_index) = imported_module.code_dir.get(&key) {
let target_code_index = code_dir
let arena = &mut LS::machine_st(payload).arena;
let target_code_index = wam_prelude.indices.code_dir
.entry(key.clone())
.or_insert_with(|| CodeIndex::new(IndexPtr::Undefined))
.or_insert_with(|| CodeIndex::new(IndexPtr::undefined(), arena))
.clone();
set_code_index(
retraction_info,
&mut payload.retraction_info,
compilation_target,
key,
&target_code_index,
target_code_index,
src_code_index.get(),
);
} else {
@@ -261,7 +261,12 @@ fn import_qualified_module_exports(
}
}
ModuleExport::OpDecl(ref op_decl) => {
add_op_decl(retraction_info, compilation_target, op_dir, op_decl);
add_op_decl(
&mut payload.retraction_info,
compilation_target,
&mut wam_prelude.indices.op_dir,
op_decl,
);
}
}
}
@@ -269,17 +274,17 @@ fn import_qualified_module_exports(
Ok(())
}
fn import_qualified_module_exports_into_module(
retraction_info: &mut RetractionInfo,
compilation_target: &CompilationTarget,
fn import_qualified_module_exports_into_module<'a, LS: LoadState<'a>>(
payload: &mut LS::LoaderFieldType,
imported_module: &Module,
exports: &IndexSet<ModuleExport>,
code_dir: &mut CodeDir,
op_dir: &mut OpDir,
meta_predicates: &mut MetaPredicateDir,
wam_op_dir: &mut OpDir,
module_op_exports: &mut ModuleOpExports,
) -> Result<(), SessionError> {
let payload_compilation_target = payload.compilation_target;
for export in imported_module.module_decl.exports.iter() {
if !exports.contains(export) {
continue;
@@ -294,16 +299,18 @@ fn import_qualified_module_exports_into_module(
}
if let Some(src_code_index) = imported_module.code_dir.get(&key) {
let arena = &mut LS::machine_st(payload).arena;
let target_code_index = code_dir
.entry(key)
.or_insert_with(|| CodeIndex::new(IndexPtr::Undefined))
.or_insert_with(|| CodeIndex::new(IndexPtr::undefined(), arena))
.clone();
set_code_index(
retraction_info,
compilation_target,
&mut payload.retraction_info,
&payload_compilation_target,
key,
&target_code_index,
target_code_index,
src_code_index.get(),
);
} else {
@@ -314,12 +321,10 @@ fn import_qualified_module_exports_into_module(
}
}
ModuleExport::OpDecl(ref op_decl) => {
add_op_decl_as_module_export(
add_op_decl_as_module_export::<LS>(
payload,
op_dir,
compilation_target,
retraction_info,
wam_op_dir,
module_op_exports,
op_decl,
);
}
@@ -464,7 +469,7 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
None => return,
};
for (key, code_index) in &removed_module.code_dir {
for (key, code_index) in removed_module.code_dir.iter_mut() {
match removed_module
.local_extensible_predicates
.get(&(CompilationTarget::User, *key))
@@ -473,7 +478,7 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
_ => {}
}
let old_index_ptr = code_index.replace(IndexPtr::Undefined);
let old_index_ptr = code_index.replace(IndexPtr::undefined());
self.payload.retraction_info
.push_record(RetractionRecord::ReplacedModulePredicate(
@@ -512,11 +517,11 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
for export in removed_module.module_decl.exports.iter() {
match export {
ModuleExport::PredicateKey(ref key) => {
match (removed_module.code_dir.get(key), code_dir.get(key)) {
match (removed_module.code_dir.get(key), code_dir.get_mut(key)) {
(Some(module_code_index), Some(target_code_index))
if module_code_index.get() == target_code_index.get() =>
{
let old_index_ptr = target_code_index.replace(IndexPtr::Undefined);
let old_index_ptr = target_code_index.replace(IndexPtr::undefined());
retraction_info.push_record(predicate_retractor(*key, old_index_ptr));
}
_ => {}
@@ -584,7 +589,10 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
Some(ref mut module) => module
.code_dir
.entry(key)
.or_insert_with(|| CodeIndex::new(IndexPtr::Undefined))
.or_insert_with(|| CodeIndex::new(
IndexPtr::undefined(),
&mut LS::machine_st(&mut self.payload).arena,
))
.clone(),
None => {
self.add_dynamically_generated_module(module_name);
@@ -593,7 +601,10 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
Some(ref mut module) => module
.code_dir
.entry(key)
.or_insert_with(|| CodeIndex::new(IndexPtr::Undefined))
.or_insert_with(|| CodeIndex::new(
IndexPtr::undefined(),
&mut LS::machine_st(&mut self.payload).arena,
))
.clone(),
None => {
unreachable!()
@@ -608,13 +619,15 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
key: PredicateKey,
compilation_target: CompilationTarget,
) -> CodeIndex {
let arena = &mut LS::machine_st(&mut self.payload).arena;
match compilation_target {
CompilationTarget::User => self
.wam_prelude
.indices
.code_dir
.entry(key)
.or_insert_with(|| CodeIndex::new(IndexPtr::Undefined))
.or_insert_with(|| CodeIndex::new(IndexPtr::undefined(), arena))
.clone(),
CompilationTarget::Module(module_name) => {
self.get_or_insert_local_code_index(module_name, key)
@@ -627,13 +640,15 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
module_name: Atom,
key: PredicateKey,
) -> CodeIndex {
let arena = &mut LS::machine_st(&mut self.payload).arena;
if module_name == atom!("user") {
return self
.wam_prelude
.indices
.code_dir
.entry(key)
.or_insert_with(|| CodeIndex::new(IndexPtr::Undefined))
.or_insert_with(|| CodeIndex::new(IndexPtr::undefined(), arena))
.clone();
} else {
self.get_or_insert_local_code_index(module_name, key)
@@ -732,14 +747,10 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
CompilationTarget::Module(ref module_name) => {
match self.wam_prelude.indices.modules.get_mut(module_name) {
Some(ref mut module) => {
let payload: &mut LoadStatePayload<_> = &mut self.payload;
add_op_decl_as_module_export(
add_op_decl_as_module_export::<LS>(
&mut self.payload,
&mut module.op_dir,
&payload.compilation_target,
&mut payload.retraction_info,
&mut self.wam_prelude.indices.op_dir,
&mut payload.module_op_exports,
op_decl,
);
}
@@ -752,7 +763,9 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
}
pub(super) fn get_clause_type(&mut self, name: Atom, arity: usize) -> ClauseType {
match ClauseType::from(name, arity) {
let arena = &mut LS::machine_st(&mut self.payload).arena;
match ClauseType::from(name, arity, arena) {
ClauseType::Named(arity, name, _) => {
let payload_compilation_target = self.payload.compilation_target;
@@ -773,7 +786,9 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
name: Atom,
arity: usize,
) -> ClauseType {
match ClauseType::from(name, arity) {
let arena = &mut LS::machine_st(&mut self.payload).arena;
match ClauseType::from(name, arity, arena) {
ClauseType::Named(arity, name, _) => {
let key = (name, arity);
let idx = self.get_or_insert_qualified_code_index(module_name, key);
@@ -784,6 +799,16 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
}
}
pub(super) fn get_meta_specs(&self, name: Atom, arity: usize) -> Option<&Vec<MetaSpec>> {
self.wam_prelude
.indices
.get_meta_predicate_spec(
name,
arity,
&self.payload.compilation_target,
)
}
pub(super) fn add_meta_predicate_record(
&mut self,
module_name: Atom,
@@ -894,8 +919,8 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
return;
}
import_module_exports(
&mut self.payload.retraction_info,
import_module_exports::<LS>(
&mut self.payload,
&module_compilation_target,
builtins,
code_dir,
@@ -992,14 +1017,10 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
for export in &module.module_decl.exports {
if let ModuleExport::OpDecl(ref op_decl) = export {
let payload: &mut LoadStatePayload<_> = &mut self.payload;
add_op_decl_as_module_export(
add_op_decl_as_module_export::<LS>(
&mut self.payload,
&mut module.op_dir,
&payload.compilation_target, // this is a Module.
&mut payload.retraction_info,
&mut self.wam_prelude.indices.op_dir,
&mut payload.module_op_exports,
op_decl,
);
}
@@ -1018,8 +1039,8 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
match &payload_compilation_target {
CompilationTarget::User => {
import_module_exports(
&mut self.payload.retraction_info,
import_module_exports::<LS>(
&mut self.payload,
&payload_compilation_target,
&module,
&mut self.wam_prelude.indices.code_dir,
@@ -1030,17 +1051,14 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
CompilationTarget::Module(ref defining_module_name) => {
match self.wam_prelude.indices.modules.get_mut(defining_module_name) {
Some(ref mut target_module) => {
let payload: &mut LoadStatePayload<_> = &mut self.payload;
import_module_exports_into_module(
&mut payload.retraction_info,
import_module_exports_into_module::<LS>(
&mut self.payload,
&payload_compilation_target,
&module,
&mut target_module.code_dir,
&mut target_module.op_dir,
&mut target_module.meta_predicates,
&mut self.wam_prelude.indices.op_dir,
&mut payload.module_op_exports,
)?;
}
None => {
@@ -1070,47 +1088,38 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
if let Some(module) = self.wam_prelude.indices.modules.remove(&module_name) {
let payload_compilation_target = self.payload.compilation_target;
match &payload_compilation_target {
let result = match &payload_compilation_target {
CompilationTarget::User => {
import_qualified_module_exports(
&mut self.payload.retraction_info,
import_qualified_module_exports::<LS>(
&mut self.payload,
&payload_compilation_target,
&module,
&exports,
&mut self.wam_prelude.indices.code_dir,
&mut self.wam_prelude.indices.op_dir,
&mut self.wam_prelude.indices.meta_predicates,
)?;
&mut self.wam_prelude,
)
}
CompilationTarget::Module(ref defining_module_name) => {
match self.wam_prelude.indices.modules.get_mut(defining_module_name) {
Some(ref mut target_module) => {
let payload: &mut LoadStatePayload<_> = &mut self.payload;
import_qualified_module_exports_into_module(
&mut payload.retraction_info,
&payload_compilation_target,
import_qualified_module_exports_into_module::<LS>(
&mut self.payload,
&module,
&exports,
&mut target_module.code_dir,
&mut target_module.op_dir,
&mut target_module.meta_predicates,
&mut self.wam_prelude.indices.op_dir,
&mut payload.module_op_exports,
)?;
)
}
None => {
// we find ourselves here because we're trying to import
// a module into itself as it is being defined.
self.wam_prelude.indices.modules.insert(module_name, module);
return Err(SessionError::ModuleCannotImportSelf(module_name));
Err(SessionError::ModuleCannotImportSelf(module_name))
}
}
}
}
};
self.wam_prelude.indices.modules.insert(module_name, module);
Ok(())
result
} else {
Err(SessionError::ExistenceError(ExistenceError::Module(module_name)))
}
@@ -1168,7 +1177,7 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
indices: self.wam_prelude.indices,
code: self.wam_prelude.code,
load_contexts: self.wam_prelude.load_contexts,
}
},
};
subloader.load()?
@@ -1231,7 +1240,7 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
indices: self.wam_prelude.indices,
code: self.wam_prelude.code,
load_contexts: self.wam_prelude.load_contexts,
}
},
};
subloader.load()?

217
src/machine/loader.rs
View File

@@ -390,6 +390,64 @@ impl<'a> LoadState<'a> for BootstrappingLoadState<'a> {
}
}
pub struct InlineLoadState<'a> {
machine_st: &'a mut MachineState,
pub payload: LoadStatePayload<InlineTermStream>,
}
impl<'a> Deref for InlineLoadState<'a> {
type Target = LoadStatePayload<InlineTermStream>;
#[inline(always)]
fn deref(&self) -> &Self::Target {
&self.payload
}
}
impl<'a> DerefMut for InlineLoadState<'a> {
#[inline(always)]
fn deref_mut(&mut self) -> &mut Self::Target {
&mut self.payload
}
}
impl<'a> LoadState<'a> for InlineLoadState<'a> {
type TS = InlineTermStream;
type LoaderFieldType = InlineLoadState<'a>;
type Evacuable = ();
#[inline(always)]
fn new(machine_st: &'a mut MachineState, payload: LoadStatePayload<Self::TS>) -> Self::LoaderFieldType {
InlineLoadState { machine_st, payload }
}
fn evacuate(_loader: Loader<'a, Self>) -> Result<Self::Evacuable, SessionError> {
Ok(())
}
#[inline(always)]
fn should_drop_load_state(_loader: &Loader<'a, Self>) -> bool {
false
}
#[inline(always)]
fn reset_machine(_loader: &mut Loader<'a, Self>) {
}
#[inline(always)]
fn machine_st(load_state: &mut Self::LoaderFieldType) -> &mut MachineState {
&mut load_state.machine_st
}
#[inline(always)]
fn err_on_builtin_overwrite(
_loader: &Loader<'a, Self>,
_key: PredicateKey,
) -> Result<(), SessionError> {
Ok(())
}
}
pub struct Loader<'a, LS: LoadState<'a>> {
pub(super) payload: LS::LoaderFieldType,
pub(super) wam_prelude: MachinePreludeView<'a>,
@@ -510,6 +568,27 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
term_stack.push(Term::Literal(Cell::default(), Literal::try_from(addr).unwrap()));
}
(HeapCellValueTag::Atom, (name, arity)) => {
let h = iter.focus();
let mut arity = arity;
if iter.heap.len() > h + arity + 1 {
let value = iter.heap[h + arity + 1];
if let Some(idx) = get_structure_index(value) {
// in the second condition, arity == 0,
// meaning idx cannot pertain to this atom
// if it is the direct subterm of a larger
// structure.
if arity > 0 || !iter.direct_subterm_of_str(h) {
term_stack.push(
Term::Literal(Cell::default(), Literal::CodeIndex(idx))
);
arity += 1;
}
}
}
if arity == 0 {
term_stack.push(Term::Literal(Cell::default(), Literal::Atom(name)));
} else {
@@ -708,7 +787,7 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
module
.code_dir
.get_mut(&key)
.map(|code_idx| code_idx.replace(old_code_idx));
.map(|code_idx| code_idx.set(old_code_idx));
}
None => {}
}
@@ -733,10 +812,9 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
.indices
.code_dir
.get_mut(&key)
.map(|code_idx| code_idx.replace(old_code_idx));
.map(|code_idx| code_idx.set(old_code_idx));
}
RetractionRecord::AddedIndex(index_key, clause_loc) => {
// WAS: inner_index_locs) => {
if let Some(index_loc) = index_key.switch_on_term_loc() {
let indexing_code = match &mut self.wam_prelude.code[index_loc] {
Instruction::IndexingCode(indexing_code) => indexing_code,
@@ -1271,13 +1349,13 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
let code_index = self.get_or_insert_code_index(key, compilation_target);
if let IndexPtr::Undefined = code_index.get() {
if code_index.is_undefined() {
set_code_index(
&mut self.payload.retraction_info,
&compilation_target,
key,
&code_index,
IndexPtr::DynamicUndefined,
code_index,
IndexPtr::dynamic_undefined(),
);
}
}
@@ -1491,7 +1569,6 @@ impl Machine {
let mut loader = self.loader_from_heap_evacuable(temp_v!(3));
let declare_module = || {
// let export_list = export_list?;
let exports = loader.extract_module_export_list_from_heap(temp_v!(2))?;
let module_decl = ModuleDecl {
@@ -1885,13 +1962,10 @@ impl Machine {
}
}
pub(crate) fn compile_assert<'a>(&'a mut self, append_or_prepend: AppendOrPrepend) -> CallResult {
let key = self
.machine_st
.read_predicate_key(self.machine_st[temp_v!(3)], self.machine_st[temp_v!(4)]);
pub(crate) fn compile_assert(&mut self, append_or_prepend: AppendOrPrepend) -> CallResult
{
let module_name = cell_as_atom!(
self.machine_st.store(self.machine_st.deref(self.machine_st.registers[5]))
self.machine_st.store(self.machine_st.deref(self.machine_st.registers[1]))
);
let compilation_target = match module_name {
@@ -1899,14 +1973,62 @@ impl Machine {
_ => CompilationTarget::Module(module_name),
};
let stub_gen = || {
match append_or_prepend {
AppendOrPrepend::Append => functor_stub(atom!("assertz"), 1),
AppendOrPrepend::Prepend => functor_stub(atom!("asserta"), 1),
}
};
let mut compile_assert = || {
let mut loader: Loader<'_, LiveLoadAndMachineState<'_>> =
Loader::new(self, LiveTermStream::new(ListingSource::User));
loader.payload.compilation_target = compilation_target;
let head = loader.read_term_from_heap(temp_v!(1))?;
let body = loader.read_term_from_heap(temp_v!(2))?;
let head = loader.read_term_from_heap(temp_v!(2))?;
let name = if let Some(name) = head.name() {
name
} else {
return Err(SessionError::from(CompilationError::InvalidRuleHead));
};
let arity = head.arity();
let is_dynamic_predicate = loader
.wam_prelude
.indices
.is_dynamic_predicate(
module_name,
(name, arity),
);
let no_such_predicate =
if !is_dynamic_predicate && !ClauseType::is_inbuilt(name, arity) {
let idx_tag = loader
.wam_prelude
.indices
.get_predicate_code_index(
name,
arity,
module_name,
)
.map(|code_idx| code_idx.get_tag())
.unwrap_or(IndexPtrTag::DynamicUndefined);
idx_tag == IndexPtrTag::DynamicUndefined ||
idx_tag == IndexPtrTag::Undefined
} else {
is_dynamic_predicate
};
if !no_such_predicate {
LiveLoadAndMachineState::machine_st(&mut loader.payload).fail = true;
return LiveLoadAndMachineState::evacuate(loader);
}
let body = loader.read_term_from_heap(temp_v!(3))?;
let asserted_clause = Term::Clause(
Cell::default(),
@@ -1915,10 +2037,10 @@ impl Machine {
);
// if a new predicate was just created, make it dynamic.
loader.add_dynamic_predicate(compilation_target, key.0, key.1)?;
loader.add_dynamic_predicate(compilation_target, name, arity)?;
loader.incremental_compile_clause(
key,
(name, arity),
asserted_clause,
compilation_target,
false,
@@ -1929,7 +2051,7 @@ impl Machine {
LiveLoadAndMachineState::machine_st(&mut loader.payload).global_clock += 1;
loader.compile_clause_clauses(
key,
(name, arity),
compilation_target,
std::iter::once((head, body)),
append_or_prepend,
@@ -1940,14 +2062,30 @@ impl Machine {
match compile_assert() {
Ok(_) => Ok(()),
Err(e) => {
let stub = match append_or_prepend {
AppendOrPrepend::Append => functor_stub(atom!("assertz"), 1),
AppendOrPrepend::Prepend => functor_stub(atom!("asserta"), 1),
};
let err = self.machine_st.session_error(e);
Err(SessionError::CompilationError(
CompilationError::InvalidRuleHead |
CompilationError::InadmissibleFact
)) => {
let err = self.machine_st.type_error(
ValidType::Callable,
self.machine_st.registers[2],
);
Err(self.machine_st.error_form(err, stub))
Err(self.machine_st.error_form(err, stub_gen()))
}
Err(SessionError::CompilationError(
CompilationError::InadmissibleQueryTerm
)) => {
let err = self.machine_st.type_error(
ValidType::Callable,
self.machine_st.registers[3],
);
Err(self.machine_st.error_form(err, stub_gen()))
}
Err(e) => {
let err = self.machine_st.session_error(e);
Err(self.machine_st.error_form(err, stub_gen()))
}
}
}
@@ -2019,10 +2157,10 @@ impl Machine {
.indices
.remove_predicate_skeleton(&compilation_target, &key);
let code_index = loader
let mut code_index = loader
.get_or_insert_code_index(key, compilation_target);
code_index.set(IndexPtr::Undefined);
code_index.set(IndexPtr::undefined());
loader.payload.compilation_target = clause_clause_compilation_target;
@@ -2187,7 +2325,7 @@ impl Machine {
let (predicate_name, arity) = self
.machine_st
.read_predicate_key(self.machine_st[temp_v!(2)], self.machine_st[temp_v!(3)]);
.read_predicate_key(self.machine_st.registers[2], self.machine_st.registers[3]);
let compilation_target = match module_name {
atom!("user") => CompilationTarget::User,
@@ -2309,21 +2447,15 @@ impl Machine {
}
pub(crate) fn builtin_property(&mut self) {
let key = self
let (name, arity) = self
.machine_st
.read_predicate_key(self.machine_st.registers[1], self.machine_st.registers[2]);
match ClauseType::from(key.0, key.1) {
ClauseType::BuiltIn(_) | ClauseType::Inlined(..) | ClauseType::CallN(_) => {
if !ClauseType::is_inbuilt(name, arity) { // ClauseType::from(key.0, key.1, &mut self.machine_st.arena) {
if let Some(module) = self.indices.modules.get(&(atom!("builtins"))) {
self.machine_st.fail = !module.code_dir.contains_key(&(name, arity));
return;
}
ClauseType::Named(arity, name, _) => {
if let Some(module) = self.indices.modules.get(&(atom!("builtins"))) {
self.machine_st.fail = !module.code_dir.contains_key(&(name, arity));
return;
}
}
_ => {}
}
self.machine_st.fail = true;
@@ -2355,14 +2487,19 @@ impl<'a> Loader<'a, LiveLoadAndMachineState<'a>> {
#[inline]
pub(super) fn load_module(
machine_st: &mut MachineState,
code_dir: &mut CodeDir,
op_dir: &mut OpDir,
meta_predicate_dir: &mut MetaPredicateDir,
compilation_target: &CompilationTarget,
module: &Module,
) {
import_module_exports(
&mut RetractionInfo::new(0),
let ts = LiveTermStream::new(ListingSource::User);
let payload = LoadStatePayload::new(0, ts);
let mut payload = LiveLoadAndMachineState::new(machine_st, payload);
import_module_exports::<LiveLoadAndMachineState>(
&mut payload,
&compilation_target,
module,
code_dir,

7
src/machine/machine_errors.rs
View File

@@ -639,10 +639,10 @@ impl CompilationError {
&CompilationError::ExpectedRel => {
functor!(atom!("expected_relation"))
}
&CompilationError::InadmissibleFact => {
&CompilationError::InadmissibleFact => { // TODO: type_error(callable, _).
functor!(atom!("inadmissible_fact"))
}
&CompilationError::InadmissibleQueryTerm => {
&CompilationError::InadmissibleQueryTerm => { // TODO: type_error(callable, _).
functor!(atom!("inadmissible_query_term"))
}
&CompilationError::InconsistentEntry => {
@@ -661,7 +661,8 @@ impl CompilationError {
functor!(atom!("no_such_module"), [atom(module_name)])
}
&CompilationError::InvalidRuleHead => {
functor!(atom!("invalid_head_of_rule"))
functor!(atom!("invalid_head_of_rule")) // TODO: type_error(callable, _).
}
&CompilationError::InvalidUseModuleDecl => {
functor!(atom!("invalid_use_module_declaration"))

185
src/machine/machine_indices.rs
View File

@@ -4,18 +4,18 @@ use crate::arena::*;
use crate::atom_table::*;
use crate::fixtures::*;
use crate::forms::*;
use crate::instructions::*;
use crate::machine::loader::*;
use crate::machine::machine_state::*;
use crate::machine::streams::Stream;
use fxhash::FxBuildHasher;
use indexmap::IndexMap;
use modular_bitfield::{BitfieldSpecifier, bitfield};
use modular_bitfield::specifiers::*;
use std::cell::Cell;
use std::cmp::Ordering;
use std::collections::BTreeSet;
use std::ops::Deref;
use std::ops::{Deref, DerefMut};
use std::rc::Rc;
use crate::types::*;
@@ -59,9 +59,6 @@ impl PartialOrd<Ref> for HeapCellValue {
}
}
(HeapCellValueTag::AttrVar | HeapCellValueTag::Var, h1) => {
// _ if self.is_ref() => {
// let h1 = self.get_value();
match r.get_tag() {
RefTag::StackCell => Some(Ordering::Less),
_ => {
@@ -77,52 +74,157 @@ impl PartialOrd<Ref> for HeapCellValue {
}
}
#[derive(Debug, Clone, Copy, Eq, Hash, Ord, PartialEq, PartialOrd)]
pub enum IndexPtr {
DynamicUndefined, // a predicate, declared as dynamic, whose location in code is as yet undefined.
DynamicIndex(usize),
Index(usize),
Undefined,
#[derive(BitfieldSpecifier, Copy, Clone, Debug, PartialEq)]
#[bits = 7]
pub enum IndexPtrTag {
DynamicUndefined = 0b1000101, // a predicate, declared as dynamic, whose location in code is as yet undefined.
DynamicIndex = 0b1000110,
Index = 0b1000111,
Undefined = 0b1001000,
}
#[derive(Debug, Clone, Ord, PartialOrd, Eq, PartialEq)]
pub struct CodeIndex(pub(crate) Rc<Cell<IndexPtr>>);
#[bitfield]
#[derive(Debug, Clone, Copy, Eq, Hash, Ord, PartialEq, PartialOrd)]
pub struct IndexPtr {
pub p: B56,
#[allow(unused)] m: bool,
pub tag: IndexPtrTag,
}
impl IndexPtr {
#[inline(always)]
pub(crate) fn dynamic_undefined() -> Self {
IndexPtr::new()
.with_p(0)
.with_m(false)
.with_tag(IndexPtrTag::DynamicUndefined)
}
#[inline(always)]
pub(crate) fn undefined() -> Self {
IndexPtr::new()
.with_p(0)
.with_m(false)
.with_tag(IndexPtrTag::Undefined)
}
#[inline(always)]
pub(crate) fn dynamic_index(p: usize) -> Self {
IndexPtr::new()
.with_p(p as u64)
.with_m(false)
.with_tag(IndexPtrTag::DynamicIndex)
}
#[inline(always)]
pub(crate) fn index(p: usize) -> Self {
IndexPtr::new()
.with_p(p as u64)
.with_m(false)
.with_tag(IndexPtrTag::Index)
}
#[inline(always)]
pub(crate) fn is_undefined(&self) -> bool {
match self.tag() {
IndexPtrTag::Undefined => true,
_ => false,
}
}
#[inline(always)]
pub(crate) fn is_dynamic_undefined(&self) -> bool {
match self.tag() {
IndexPtrTag::DynamicUndefined => true,
_ => false,
}
}
}
#[derive(Debug, Clone, Copy, Ord, Hash, PartialOrd, Eq, PartialEq)]
pub struct CodeIndex(TypedArenaPtr<IndexPtr>);
const_assert!(std::mem::align_of::<CodeIndex>() == 8);
impl Deref for CodeIndex {
type Target = Cell<IndexPtr>;
type Target = TypedArenaPtr<IndexPtr>;
#[inline]
fn deref(&self) -> &Self::Target {
self.0.deref()
#[inline(always)]
fn deref(&self) -> &TypedArenaPtr<IndexPtr> {
&self.0
}
}
impl DerefMut for CodeIndex {
#[inline(always)]
fn deref_mut(&mut self) -> &mut TypedArenaPtr<IndexPtr> {
&mut self.0
}
}
impl From<CodeIndex> for UntypedArenaPtr {
#[inline(always)]
fn from(ptr: CodeIndex) -> UntypedArenaPtr {
unsafe { std::mem::transmute(ptr.0.as_ptr()) }
}
}
impl From<UntypedArenaPtr> for CodeIndex {
#[inline(always)]
fn from(ptr: UntypedArenaPtr) -> CodeIndex {
CodeIndex(TypedArenaPtr::new(ptr.get_ptr() as *mut IndexPtr))
}
}
impl From<TypedArenaPtr<IndexPtr>> for CodeIndex {
#[inline(always)]
fn from(ptr: TypedArenaPtr<IndexPtr>) -> CodeIndex {
CodeIndex(ptr)
}
}
impl CodeIndex {
#[inline]
pub(super) fn new(ptr: IndexPtr) -> Self {
CodeIndex(Rc::new(Cell::new(ptr)))
pub(crate) fn new(ptr: IndexPtr, arena: &mut Arena) -> Self {
CodeIndex(arena_alloc!(ptr, arena))
}
#[inline]
pub(crate) fn is_undefined(&self) -> bool {
match self.0.get() {
IndexPtr::Undefined => true, // | &IndexPtr::DynamicUndefined => true,
_ => false,
}
#[inline(always)]
pub(crate) fn default(arena: &mut Arena) -> Self {
CodeIndex::new(IndexPtr::undefined(), arena)
}
pub(crate) fn local(&self) -> Option<usize> {
match self.0.get() {
IndexPtr::Index(i) => Some(i),
IndexPtr::DynamicIndex(i) => Some(i),
match self.0.tag() {
IndexPtrTag::Index => Some(self.0.p() as usize),
IndexPtrTag::DynamicIndex => Some(self.0.p() as usize),
_ => None,
}
}
}
impl Default for CodeIndex {
fn default() -> Self {
CodeIndex(Rc::new(Cell::new(IndexPtr::Undefined)))
#[inline(always)]
pub(crate) fn get(&self) -> IndexPtr {
*self.0.deref()
}
#[inline(always)]
pub(crate) fn set(&mut self, value: IndexPtr) {
*self.0.deref_mut() = value;
}
#[inline(always)]
pub(crate) fn get_tag(self) -> IndexPtrTag {
self.0.tag()
}
#[inline(always)]
pub(crate) fn replace(&mut self, value: IndexPtr) -> IndexPtr {
std::mem::replace(self.0.deref_mut(), value)
}
#[inline(always)]
pub(crate) fn as_ptr(&self) -> *const IndexPtr {
self.0.as_ptr()
}
}
@@ -269,19 +371,22 @@ impl IndexStore {
module: Atom,
) -> Option<CodeIndex> {
if module == atom!("user") {
match ClauseType::from(name, arity) {
ClauseType::Named(arity, name, _) => self.code_dir.get(&(name, arity)).cloned(),
_ => None,
}
/*match ClauseType::from(name, arity) {
ClauseType::Named(arity, name, _) => */
self.code_dir.get(&(name, arity)).cloned()
/* _ => None,
}*/
} else {
self.modules
.get(&module)
.and_then(|module| match ClauseType::from(name, arity) {
ClauseType::Named(arity, name, _) => {
.and_then(|module|/* |module| match ClauseType::from(name, arity) {
ClauseType::Named(arity, name, _) => { */
module.code_dir.get(&(name, arity)).cloned()
/*
}
_ => None,
})
} */
)
}
}

112
src/machine/machine_state.rs
View File

@@ -75,6 +75,7 @@ pub struct MachineState {
pub(super) hb: usize,
pub(super) block: usize, // an offset into the OR stack.
pub(super) ball: Ball,
pub(super) ball_stack: Vec<Ball>, // save current ball before jumping via, e.g., verify_attr interrupt.
pub(super) lifted_heap: Heap,
pub(super) interms: Vec<Number>, // intermediate numbers.
// locations of cleaners, cut points, the previous block. for setup_call_cleanup.
@@ -113,6 +114,7 @@ impl fmt::Debug for MachineState {
.field("hb", &self.hb)
.field("block", &self.block)
.field("ball", &self.ball)
.field("ball_stack", &self.ball_stack)
.field("lifted_heap", &self.lifted_heap)
.field("interms", &self.interms)
.field("flags", &self.flags)
@@ -418,6 +420,17 @@ impl MachineState {
}
}
}
(HeapCellValueTag::Str, s) => {
let (name, arity) = cell_as_atom_cell!(self.heap[s])
.get_name_and_arity();
if arity == 0 {
if let Some(c) = name.as_char() {
chars.push(c);
continue;
}
}
}
_ => {
}
);
@@ -454,6 +467,20 @@ impl MachineState {
self.b0 = self.b;
}
#[inline(always)]
pub fn neck_cut(&mut self) {
let b = self.b;
let b0 = self.b0;
if b > b0 {
self.b = b0;
if b > self.e {
self.stack.truncate(b);
}
}
}
// Safety: the atom_tbl lives for the lifetime of the machine, as does the helper, so the ptr
// will always be valid.
pub fn read_term_from_user_input(&mut self, stream: Stream, indices: &mut IndexStore) -> CallResult {
@@ -511,7 +538,7 @@ impl MachineState {
loop {
match self.read(stream, &indices.op_dir) {
Ok(term_write_result) => {
Ok(mut term_write_result) => {
let heap_loc = read_heap_cell!(self.heap[term_write_result.heap_loc],
(HeapCellValueTag::PStr | HeapCellValueTag::PStrOffset) => {
pstr_loc_as_cell!(term_write_result.heap_loc)
@@ -543,6 +570,10 @@ impl MachineState {
}
}
for var in term_write_result.var_dict.values_mut() {
*var = heap_bound_deref(&self.heap, *var);
}
let singleton_var_list = push_var_eq_functors(
&mut self.heap,
term_write_result.var_dict.iter().filter(|(_, binding)| {
@@ -666,6 +697,13 @@ impl MachineState {
debug_assert_eq!(_arity, 0);
var_names.insert(var, Rc::new(name.as_str().to_owned()));
}
(HeapCellValueTag::Str, s) => {
let (name, arity) = cell_as_atom_cell!(self.heap[s])
.get_name_and_arity();
debug_assert_eq!(arity, 0);
var_names.insert(var, Rc::new(name.as_str().to_owned()));
}
_ => {
unreachable!();
}
@@ -677,34 +715,64 @@ impl MachineState {
);
}
let ignore_ops = read_heap_cell!(ignore_ops,
(HeapCellValueTag::Atom, (name, _arity)) => {
name == atom!("true")
}
(HeapCellValueTag::Str, s) => {
let (name, arity) = cell_as_atom_cell!(self.heap[s])
.get_name_and_arity();
debug_assert_eq!(arity, 0);
name == atom!("true")
}
_ => {
unreachable!()
}
);
let numbervars = read_heap_cell!(numbervars,
(HeapCellValueTag::Atom, (name, _arity)) => {
name == atom!("true")
}
(HeapCellValueTag::Str, s) => {
let (name, arity) = cell_as_atom_cell!(self.heap[s])
.get_name_and_arity();
debug_assert_eq!(arity, 0);
name == atom!("true")
}
_ => {
unreachable!()
}
);
let quoted = read_heap_cell!(quoted,
(HeapCellValueTag::Atom, (name, _arity)) => {
name == atom!("true")
}
(HeapCellValueTag::Str, s) => {
let (name, arity) = cell_as_atom_cell!(self.heap[s])
.get_name_and_arity();
debug_assert_eq!(arity, 0);
name == atom!("true")
}
_ => {
unreachable!()
}
);
let mut printer = HCPrinter::new(
&mut self.heap,
&mut self.arena,
op_dir,
PrinterOutputter::new(),
term_to_be_printed,
);
if let HeapCellValueTag::Atom = ignore_ops.get_tag() {
let name = cell_as_atom!(ignore_ops);
printer.ignore_ops = name == atom!("true");
} else {
unreachable!();
}
if let HeapCellValueTag::Atom = numbervars.get_tag() {
let name = cell_as_atom!(numbervars);
printer.numbervars = name == atom!("true");
} else {
unreachable!();
}
if let HeapCellValueTag::Atom = quoted.get_tag() {
let name = cell_as_atom!(quoted);
printer.quoted = name == atom!("true");
} else {
unreachable!();
}
printer.ignore_ops = ignore_ops;
printer.numbervars = numbervars;
printer.quoted = quoted;
match Number::try_from(max_depth) {
Ok(Number::Fixnum(n)) => {

162
src/machine/machine_state_impl.rs
View File

@@ -47,6 +47,7 @@ impl MachineState {
hb: 0,
block: 0,
ball: Ball::new(),
ball_stack: vec![],
lifted_heap: Heap::new(),
interms: vec![Number::default();256],
cont_pts: Vec::with_capacity(256),
@@ -347,10 +348,27 @@ impl MachineState {
debug_assert_eq!(arity, 0);
self.fail = cstr_atom != atom!("[]");
}
(HeapCellValueTag::Str, s) => {
let (name, arity) = cell_as_atom_cell!(self.heap[s])
.get_name_and_arity();
if arity == 0 {
self.fail = atom == atom!("") && name != atom!("[]");
} else {
// this is intentionally the same policy for
// value.tag() == Lis and PStrLoc. they're not
// grouped together to allow for arity == 0.
self.unify_partial_string(atom_as_cstr_cell!(atom), value);
if !self.pdl.is_empty() {
self.unify();
}
}
}
(HeapCellValueTag::CStr, cstr_atom) => {
self.fail = atom != cstr_atom;
}
(HeapCellValueTag::Str | HeapCellValueTag::Lis | HeapCellValueTag::PStrLoc) => {
(HeapCellValueTag::Lis | HeapCellValueTag::PStrLoc) => {
self.unify_partial_string(atom_as_cstr_cell!(atom), value);
if !self.pdl.is_empty() {
@@ -553,6 +571,12 @@ impl MachineState {
(HeapCellValueTag::Atom, (name, arity)) => {
self.fail = !(arity == 0 && name == atom);
}
(HeapCellValueTag::Str, s) => {
let (name, arity) = cell_as_atom_cell!(self.heap[s])
.get_name_and_arity();
self.fail = !(arity == 0 && name == atom);
}
(HeapCellValueTag::CStr, cstr_atom) if atom == atom!("[]") => {
self.fail = cstr_atom != atom!("");
}
@@ -587,6 +611,16 @@ impl MachineState {
self.fail = true;
}
}
(HeapCellValueTag::Str, s) => {
let (name, arity) = cell_as_atom_cell!(self.heap[s])
.get_name_and_arity();
if let Some(c2) = name.as_char() {
self.fail = !(c == c2 && arity == 0);
} else {
self.fail = true;
}
}
(HeapCellValueTag::Char, c2) => {
if c != c2 {
self.fail = true;
@@ -739,11 +773,6 @@ impl MachineState {
self.unify_atom(name, d2);
}
(HeapCellValueTag::Str, s1) => {
if d2.is_constant() {
self.fail = true;
break;
}
if tabu_list.contains(&(d1, d2)) {
continue;
}
@@ -969,9 +998,7 @@ impl MachineState {
}
}
(HeapCellValueTag::Atom, (n2, a2)) => {
if !(a1 == 0 && a2 == 0 && n1 == n2) {
self.fail = true;
}
self.fail = !(a1 == 0 && a2 == 0 && n1 == n2);
}
(HeapCellValueTag::AttrVar, h) => {
if self.bind_with_occurs_check(Ref::attr_var(h), str_loc_as_cell!(s1)) {
@@ -1285,11 +1312,6 @@ impl MachineState {
self.unify_atom(name, d2);
}
(HeapCellValueTag::Str, s1) => {
if d2.is_constant() {
self.fail = true;
break;
}
if tabu_list.contains(&(d1, d2)) {
continue;
}
@@ -1492,8 +1514,8 @@ impl MachineState {
let v1 = self.store(s1);
let v2 = self.store(s2);
let order_cat_v1 = v1.order_category();
let order_cat_v2 = v2.order_category();
let order_cat_v1 = v1.order_category(&self.heap);
let order_cat_v2 = v2.order_category(&self.heap);
if order_cat_v1 != order_cat_v2 {
self.pdl.clear();
@@ -1552,6 +1574,15 @@ impl MachineState {
);
}
}
(HeapCellValueTag::Str, s) => {
let n2 = cell_as_atom_cell!(self.heap[s])
.get_name();
if n1 != n2 {
self.pdl.clear();
return Some(n1.cmp(&n2));
}
}
_ => {
unreachable!();
}
@@ -1579,11 +1610,67 @@ impl MachineState {
return Some(c1.cmp(&c2));
}
}
(HeapCellValueTag::Str, s) => {
let n2 = cell_as_atom_cell!(self.heap[s])
.get_name();
if let Some(c2) = n2.as_char() {
if c1 != c2 {
self.pdl.clear();
return Some(c1.cmp(&c2));
}
} else {
self.pdl.clear();
return Some(
Some(c1).cmp(&n2.chars().next())
.then(Ordering::Less)
);
}
}
_ => {
unreachable!()
}
)
}
(HeapCellValueTag::Str, s) => {
let n1 = cell_as_atom_cell!(self.heap[s])
.get_name();
read_heap_cell!(v2,
(HeapCellValueTag::Atom, (n2, _a2)) => {
if n1 != n2 {
self.pdl.clear();
return Some(n1.cmp(&n2));
}
}
(HeapCellValueTag::Char, c2) => {
if let Some(c1) = n1.as_char() {
if c1 != c2 {
self.pdl.clear();
return Some(c1.cmp(&c2));
}
} else {
self.pdl.clear();
return Some(
n1.chars().next().cmp(&Some(c2))
.then(Ordering::Greater)
);
}
}
(HeapCellValueTag::Str, s) => {
let n2 = cell_as_atom_cell!(self.heap[s])
.get_name();
if n1 != n2 {
self.pdl.clear();
return Some(n1.cmp(&n2));
}
}
_ => {
unreachable!();
}
)
}
_ => {
unreachable!()
}
@@ -1597,8 +1684,8 @@ impl MachineState {
) -> Option<Ordering> {
let compound = Some(TermOrderCategory::Compound);
if iter2.focus.order_category() != compound {
Some(compound.cmp(&iter2.focus.order_category()))
if iter2.focus.order_category(iter2.heap) != compound {
Some(compound.cmp(&iter2.focus.order_category(iter2.heap)))
} else {
let c1 = match iteratee {
PStrIteratee::Char(_, c) => c,
@@ -2116,7 +2203,7 @@ impl MachineState {
heap_bound_deref(iter.heap, value),
));
if value.is_compound() {
if value.is_compound(iter.heap) {
return true;
}
}
@@ -2403,6 +2490,21 @@ impl MachineState {
a1.as_var().unwrap(),
);
}
(HeapCellValueTag::Str, s) => {
let (name, atom_arity) = cell_as_atom_cell!(self.heap[s])
.get_name_and_arity();
if atom_arity == 0 {
self.try_functor_fabricate_struct(
name,
arity as usize,
a1.as_var().unwrap(),
);
} else {
let err = self.type_error(ValidType::Atomic, store_name);
return Err(self.error_form(err, stub_gen()));
}
}
(HeapCellValueTag::Char, c) => {
let c = self.atom_tbl.build_with(&c.to_string());
@@ -2444,6 +2546,17 @@ impl MachineState {
let err = self.instantiation_error();
Err(self.error_form(err, stub_gen()))
}
(HeapCellValueTag::Str, s) => {
let (name, arity) = cell_as_atom_cell!(self.heap[s])
.get_name_and_arity();
if name == atom!("[]") && arity == 0 {
Ok(vec![])
} else {
let err = self.type_error(ValidType::List, value);
Err(self.error_form(err, stub_gen()))
}
}
(HeapCellValueTag::Atom, (name, arity)) => {
if name == atom!("[]") && arity == 0 {
Ok(vec![])
@@ -2484,6 +2597,17 @@ impl MachineState {
(HeapCellValueTag::PStrLoc, l) => {
return self.try_from_partial_string(result, l, stub_gen, a1);
}
(HeapCellValueTag::Str, s) => {
let (name, arity) = cell_as_atom_cell!(self.heap[s])
.get_name_and_arity();
if name == atom!("[]") && arity == 0 {
break;
} else {
let err = self.type_error(ValidType::List, a1);
return Err(self.error_form(err, stub_gen()));
}
}
(HeapCellValueTag::Atom, (name, arity)) => {
if name == atom!("[]") && arity == 0 {
break;

3
src/machine/mock_wam.rs
View File

@@ -61,7 +61,6 @@ impl MockWAM {
let mut printer = HCPrinter::new(
&mut self.machine_st.heap,
&mut self.machine_st.arena,
&self.op_dir,
PrinterOutputter::new(),
heap_loc_as_cell!(term_write_result.heap_loc),
@@ -272,6 +271,7 @@ impl Machine {
if let Some(ref mut builtins) = wam.indices.modules.get_mut(&atom!("builtins")) {
load_module(
&mut wam.machine_st,
&mut wam.indices.code_dir,
&mut wam.indices.op_dir,
&mut wam.indices.meta_predicates,
@@ -297,6 +297,7 @@ impl Machine {
if let Some(loader) = wam.indices.modules.get(&atom!("loader")) {
load_module(
&mut wam.machine_st,
&mut wam.indices.code_dir,
&mut wam.indices.op_dir,
&mut wam.indices.meta_predicates,

64
src/machine/mod.rs
View File

@@ -22,6 +22,7 @@ pub mod streams;
pub mod system_calls;
pub mod term_stream;
use crate::arena::*;
use crate::arithmetic::*;
use crate::atom_table::*;
use crate::forms::*;
@@ -160,6 +161,24 @@ pub(crate) fn import_builtin_impls(code_dir: &CodeDir, builtins: &mut Module) {
}
}
#[inline]
pub(crate) fn get_structure_index(value: HeapCellValue) -> Option<CodeIndex> {
read_heap_cell!(value,
(HeapCellValueTag::Cons, cons_ptr) => {
match_untyped_arena_ptr!(cons_ptr,
(ArenaHeaderTag::IndexPtr, ip) => {
return Some(CodeIndex::from(ip));
}
_ => {}
);
}
_ => {
}
);
None
}
impl Machine {
#[inline]
pub fn prelude_view_and_machine_st(&mut self) -> (MachinePreludeView, &mut MachineState) {
@@ -220,6 +239,7 @@ impl Machine {
if let Some(toplevel) = self.indices.modules.get(&atom!("$toplevel")) {
load_module(
&mut self.machine_st,
&mut self.indices.code_dir,
&mut self.indices.op_dir,
&mut self.indices.meta_predicates,
@@ -287,7 +307,7 @@ impl Machine {
}
pub(crate) fn configure_modules(&mut self) {
fn update_call_n_indices(loader: &Module, target_code_dir: &mut CodeDir) {
fn update_call_n_indices(loader: &Module, target_code_dir: &mut CodeDir, arena: &mut Arena) {
for arity in 1..66 {
let key = (atom!("call"), arity);
@@ -295,7 +315,7 @@ impl Machine {
Some(src_code_index) => {
let target_code_index = target_code_dir
.entry(key)
.or_insert_with(|| CodeIndex::new(IndexPtr::Undefined));
.or_insert_with(|| CodeIndex::new(IndexPtr::undefined(), arena));
target_code_index.set(src_code_index.get());
}
@@ -311,6 +331,7 @@ impl Machine {
// Import loader's exports into the builtins module so they will be
// implicitly included in every further module.
load_module(
&mut self.machine_st,
&mut builtins.code_dir,
&mut builtins.op_dir,
&mut builtins.meta_predicates,
@@ -331,10 +352,10 @@ impl Machine {
}
for (_, target_module) in self.indices.modules.iter_mut() {
update_call_n_indices(&loader, &mut target_module.code_dir);
update_call_n_indices(&loader, &mut target_module.code_dir, &mut self.machine_st.arena);
}
update_call_n_indices(&loader, &mut self.indices.code_dir);
update_call_n_indices(&loader, &mut self.indices.code_dir, &mut self.machine_st.arena);
self.indices.modules.insert(atom!("loader"), loader);
} else {
@@ -393,7 +414,10 @@ impl Machine {
for (p, instr) in self.code[impls_offset ..].iter().enumerate() {
let key = instr.to_name_and_arity();
self.indices.code_dir.insert(key, CodeIndex::new(IndexPtr::Index(p + impls_offset)));
self.indices.code_dir.insert(
key,
CodeIndex::new(IndexPtr::index(p + impls_offset), &mut self.machine_st.arena),
);
}
}
@@ -407,9 +431,7 @@ impl Machine {
let user_output = Stream::stdout(&mut machine_st.arena);
let user_error = Stream::stderr(&mut machine_st.arena);
let runtime = tokio::runtime::Builder::new_current_thread()
.enable_all()
.build()
let runtime = tokio::runtime::Runtime::new()
.unwrap();
let mut wam = Machine {
@@ -455,6 +477,7 @@ impl Machine {
if let Some(builtins) = wam.indices.modules.get_mut(&atom!("builtins")) {
load_module(
&mut wam.machine_st,
&mut wam.indices.code_dir,
&mut wam.indices.op_dir,
&mut wam.indices.meta_predicates,
@@ -480,6 +503,7 @@ impl Machine {
if let Some(loader) = wam.indices.modules.get(&atom!("loader")) {
load_module(
&mut wam.machine_st,
&mut wam.indices.code_dir,
&mut wam.indices.op_dir,
&mut wam.indices.meta_predicates,
@@ -666,18 +690,20 @@ impl Machine {
#[inline(always)]
fn try_call(&mut self, name: Atom, arity: usize, idx: IndexPtr) -> CallResult {
match idx {
IndexPtr::DynamicUndefined => {
let compiled_tl_index = idx.p() as usize;
match idx.tag() {
IndexPtrTag::DynamicUndefined => {
self.machine_st.fail = true;
}
IndexPtr::Undefined => {
IndexPtrTag::Undefined => {
return Err(self.machine_st.throw_undefined_error(name, arity));
}
IndexPtr::DynamicIndex(compiled_tl_index) => {
IndexPtrTag::DynamicIndex => {
self.machine_st.dynamic_mode = FirstOrNext::First;
self.machine_st.call_at_index(arity, compiled_tl_index);
}
IndexPtr::Index(compiled_tl_index) => {
IndexPtrTag::Index => {
self.machine_st.call_at_index(arity, compiled_tl_index);
}
}
@@ -687,18 +713,20 @@ impl Machine {
#[inline(always)]
fn try_execute(&mut self, name: Atom, arity: usize, idx: IndexPtr) -> CallResult {
match idx {
IndexPtr::DynamicUndefined => {
let compiled_tl_index = idx.p() as usize;
match idx.tag() {
IndexPtrTag::DynamicUndefined => {
self.machine_st.fail = true;
}
IndexPtr::Undefined => {
IndexPtrTag::Undefined => {
return Err(self.machine_st.throw_undefined_error(name, arity));
}
IndexPtr::DynamicIndex(compiled_tl_index) => {
IndexPtrTag::DynamicIndex => {
self.machine_st.dynamic_mode = FirstOrNext::First;
self.machine_st.execute_at_index(arity, compiled_tl_index);
}
IndexPtr::Index(compiled_tl_index) => {
IndexPtrTag::Index => {
self.machine_st.execute_at_index(arity, compiled_tl_index)
}
}

10
src/machine/partial_string.rs
View File

@@ -179,6 +179,14 @@ impl<'a> HeapPStrIter<'a> {
if self.at_string_terminator() {
self.focus = empty_list_as_cell!();
self.brent_st.hare = result.focus;
} else {
read_heap_cell!(self.heap[result.focus],
(HeapCellValueTag::Lis | HeapCellValueTag::Str) => {
self.focus = self.heap[self.brent_st.hare];
}
_ => {
}
);
}
}
@@ -330,7 +338,7 @@ impl<'a> HeapPStrIter<'a> {
})
} else {
None
}
};
}
(HeapCellValueTag::Str, s) => {
let (name, arity) = cell_as_atom_cell!(self.heap[s])

336
src/machine/preprocessor.rs
View File

@@ -470,14 +470,141 @@ pub(super) fn setup_declaration<'a, LS: LoadState<'a>>(
}
}
fn build_meta_predicate_clause<'a, LS: LoadState<'a>>(
loader: &mut Loader<'a, LS>,
module_name: Atom,
terms: Vec<Term>,
meta_specs: Vec<MetaSpec>,
) -> Vec<Term> {
let mut arg_terms = Vec::with_capacity(terms.len());
for (term, meta_spec) in terms.into_iter().zip(meta_specs.iter()) {
if let MetaSpec::RequiresExpansionWithArgument(supp_args) = meta_spec {
if let Some(name) = term.name() {
if name == atom!("$call") {
arg_terms.push(term);
continue;
}
let arity = term.arity();
fn get_qualified_name(
module_term: &Term,
qualified_term: &Term,
) -> Option<(Atom, Atom)> {
if let Term::Literal(_, Literal::Atom(module_name)) = module_term {
if let Some(name) = qualified_term.name() {
return Some((*module_name, name));
}
}
None
}
fn identity_fn(_module_name: Atom, term: Term) -> Term {
term
}
fn tag_with_module_name(module_name: Atom, term: Term) -> Term {
Term::Clause(Cell::default(), atom!(":"), vec![
Term::Literal(Cell::default(), Literal::Atom(module_name)),
term
])
}
let process_term: fn(Atom, Term) -> Term;
let (module_name, key, term) = match term {
Term::Clause(cell, atom!(":"), mut terms) if terms.len() == 2 => {
if let Some((module_name, name)) = get_qualified_name(&terms[0], &terms[1]) {
process_term = tag_with_module_name;
(module_name, (name, terms[1].arity() + supp_args), terms.pop().unwrap())
} else {
arg_terms.push(Term::Clause(cell, atom!(":"), terms));
continue;
}
}
term => {
process_term = identity_fn;
(module_name, (name, arity + supp_args), term)
}
};
let term = match term {
Term::Clause(cell, name, mut terms) => {
if let Some(Term::Literal(_, Literal::CodeIndex(_))) = terms.last() {
arg_terms.push(process_term(
module_name,
Term::Clause(cell, name, terms),
));
continue;
}
let idx = loader.get_or_insert_qualified_code_index(module_name, key);
terms.push(Term::Literal(Cell::default(), Literal::CodeIndex(idx)));
process_term(module_name, Term::Clause(cell, name, terms))
}
Term::Literal(cell, Literal::Atom(name)) => {
let idx = loader.get_or_insert_qualified_code_index(module_name, key);
process_term(module_name, Term::Clause(
cell,
name,
vec![Term::Literal(Cell::default(), Literal::CodeIndex(idx))],
))
}
term => term,
};
arg_terms.push(term);
continue;
}
}
arg_terms.push(term);
}
arg_terms
}
#[inline]
fn clause_to_query_term<'a, LS: LoadState<'a>>(
loader: &mut Loader<'a, LS>,
name: Atom,
terms: Vec<Term>,
mut terms: Vec<Term>,
call_policy: CallPolicy,
) -> QueryTerm {
let ct = loader.get_clause_type(name, terms.len());
if let Some(Term::Literal(_, Literal::CodeIndex(_))) = terms.last() {
// supplementary code vector indices are unnecessary for
// root-level clauses.
terms.pop();
}
let mut ct = loader.get_clause_type(name, terms.len());
if let ClauseType::Named(arity, name, idx) = ct {
if let Some(meta_specs) = loader.get_meta_specs(name, arity).cloned() {
let module_name = loader.payload.compilation_target.module_name();
let terms = build_meta_predicate_clause(
loader,
module_name,
terms,
meta_specs,
);
return QueryTerm::Clause(
Cell::default(),
ClauseType::Named(arity, name, idx),
terms,
call_policy,
);
}
ct = ClauseType::Named(arity, name, idx);
}
QueryTerm::Clause(Cell::default(), ct, terms, call_policy)
}
@@ -486,13 +613,120 @@ fn qualified_clause_to_query_term<'a, LS: LoadState<'a>>(
loader: &mut Loader<'a, LS>,
module_name: Atom,
name: Atom,
terms: Vec<Term>,
mut terms: Vec<Term>,
call_policy: CallPolicy,
) -> QueryTerm {
let ct = loader.get_qualified_clause_type(module_name, name, terms.len());
if let Some(Term::Literal(_, Literal::CodeIndex(_))) = terms.last() {
// supplementary code vector indices are unnecessary for
// root-level clauses.
terms.pop();
}
let mut ct = loader.get_qualified_clause_type(module_name, name, terms.len());
if let ClauseType::Named(arity, name, idx) = ct {
if let Some(meta_specs) = loader.get_meta_specs(name, arity).cloned() {
let terms = build_meta_predicate_clause(
loader,
module_name,
terms,
meta_specs,
);
return QueryTerm::Clause(
Cell::default(),
ClauseType::Named(arity, name, idx),
terms,
call_policy,
);
}
ct = ClauseType::Named(arity, name, idx);
}
QueryTerm::Clause(Cell::default(), ct, terms, call_policy)
}
fn compute_head(term: &Term) -> Vec<Term> {
let mut vars = IndexSet::new();
for term in post_order_iter(term) {
if let TermRef::Var(_, _, v) = term {
vars.insert(v.clone());
}
}
vars.insert(Rc::new(String::from("!")));
vars.into_iter()
.map(|v| Term::Var(Cell::default(), v))
.collect()
}
pub(crate) fn build_rule_body(vars: &[Term], body_term: Term) -> Term {
let head_term = Term::Clause(Cell::default(), atom!(""), vars.iter().cloned().collect());
let rule = vec![head_term, body_term];
Term::Clause(Cell::default(), atom!(":-"), rule)
}
// the terms form the body of the rule. We create a head, by
// gathering variables from the body of terms and recording them
// in the head clause.
fn build_rule(body_term: Term) -> (JumpStub, VecDeque<Term>) {
// collect the vars of body_term into a head, return the num_vars
// (the arity) as well.
let vars = compute_head(&body_term);
let rule = build_rule_body(&vars, body_term);
(vars, VecDeque::from(vec![rule]))
}
fn build_disjunct(body_term: Term) -> (JumpStub, VecDeque<Term>) {
let vars = compute_head(&body_term);
let results = unfold_by_str(body_term, atom!(";"))
.into_iter()
.map(|term| {
let mut subterms = unfold_by_str(term, atom!(","));
mark_cut_variables(&mut subterms);
check_for_internal_if_then(&mut subterms);
let term = subterms.pop().unwrap();
let clause = fold_by_str(subterms.into_iter(), term, atom!(","));
build_rule_body(&vars, clause)
})
.collect();
(vars, results)
}
fn build_if_then(prec: Term, conq: Term) -> (JumpStub, VecDeque<Term>) {
let mut prec_seq = unfold_by_str(prec, atom!(","));
let comma_sym = atom!(",");
let cut_sym = Literal::Atom(atom!("!"));
prec_seq.push(Term::Literal(Cell::default(), cut_sym));
mark_cut_variables_as(&mut prec_seq, atom!("blocked_!"));
let mut conq_seq = unfold_by_str(conq, atom!(","));
mark_cut_variables(&mut conq_seq);
prec_seq.extend(conq_seq.into_iter());
let back_term = prec_seq.pop().unwrap();
let front_term = prec_seq.pop().unwrap();
let body_term = Term::Clause(
Cell::default(),
comma_sym,
vec![front_term, back_term],
);
build_rule(fold_by_str(prec_seq.into_iter(), body_term, comma_sym))
}
#[derive(Debug)]
pub(crate) struct Preprocessor {
queue: VecDeque<VecDeque<Term>>,
@@ -514,86 +748,6 @@ impl Preprocessor {
}
}
fn compute_head(&self, term: &Term) -> Vec<Term> {
let mut vars = IndexSet::new();
for term in post_order_iter(term) {
if let TermRef::Var(_, _, v) = term {
vars.insert(v.clone());
}
}
vars.insert(Rc::new(String::from("!")));
vars.into_iter()
.map(|v| Term::Var(Cell::default(), v))
.collect()
}
fn fabricate_rule_body(&self, vars: &Vec<Term>, body_term: Term) -> Term {
let head_term = Term::Clause(Cell::default(), atom!(""), vars.clone());
let rule = vec![head_term, body_term];
Term::Clause(Cell::default(), atom!(":-"), rule)
}
// the terms form the body of the rule. We create a head, by
// gathering variables from the body of terms and recording them
// in the head clause.
fn fabricate_rule(&self, body_term: Term) -> (JumpStub, VecDeque<Term>) {
// collect the vars of body_term into a head, return the num_vars
// (the arity) as well.
let vars = self.compute_head(&body_term);
let rule = self.fabricate_rule_body(&vars, body_term);
(vars, VecDeque::from(vec![rule]))
}
fn fabricate_disjunct(&self, body_term: Term) -> (JumpStub, VecDeque<Term>) {
let vars = self.compute_head(&body_term);
let results = unfold_by_str(body_term, atom!(";"))
.into_iter()
.map(|term| {
let mut subterms = unfold_by_str(term, atom!(","));
mark_cut_variables(&mut subterms);
check_for_internal_if_then(&mut subterms);
let term = subterms.pop().unwrap();
let clause = fold_by_str(subterms.into_iter(), term, atom!(","));
self.fabricate_rule_body(&vars, clause)
})
.collect();
(vars, results)
}
fn fabricate_if_then(&self, prec: Term, conq: Term) -> (JumpStub, VecDeque<Term>) {
let mut prec_seq = unfold_by_str(prec, atom!(","));
let comma_sym = atom!(",");
let cut_sym = Literal::Atom(atom!("!"));
prec_seq.push(Term::Literal(Cell::default(), cut_sym));
mark_cut_variables_as(&mut prec_seq, atom!("blocked_!"));
let mut conq_seq = unfold_by_str(conq, atom!(","));
mark_cut_variables(&mut conq_seq);
prec_seq.extend(conq_seq.into_iter());
let back_term = prec_seq.pop().unwrap();
let front_term = prec_seq.pop().unwrap();
let body_term = Term::Clause(
Cell::default(),
comma_sym,
vec![front_term, back_term],
);
self.fabricate_rule(fold_by_str(prec_seq.into_iter(), body_term, comma_sym))
}
fn to_query_term<'a, LS: LoadState<'a>>(
&mut self,
loader: &mut Loader<'a, LS>,
@@ -605,7 +759,9 @@ impl Preprocessor {
Ok(QueryTerm::BlockedCut)
} else {
Ok(clause_to_query_term(
loader, name, vec![],
loader,
name,
vec![],
self.settings.default_call_policy(),
))
}
@@ -618,7 +774,7 @@ impl Preprocessor {
(atom!(";"), 2) => {
let term = Term::Clause(r, name, terms);
let (stub, clauses) = self.fabricate_disjunct(term);
let (stub, clauses) = build_disjunct(term);
self.queue.push_back(clauses);
Ok(QueryTerm::Jump(stub))
@@ -627,7 +783,7 @@ impl Preprocessor {
let conq = terms.pop().unwrap();
let prec = terms.pop().unwrap();
let (stub, clauses) = self.fabricate_if_then(prec, conq);
let (stub, clauses) = build_if_then(prec, conq);
self.queue.push_back(clauses);
Ok(QueryTerm::Jump(stub))
@@ -644,7 +800,7 @@ impl Preprocessor {
let terms = vec![prec, conq];
let term = Term::Clause(Cell::default(), atom!(";"), terms);
let (stub, clauses) = self.fabricate_disjunct(term);
let (stub, clauses) = build_disjunct(term);
debug_assert!(clauses.len() > 0);
self.queue.push_back(clauses);
@@ -689,8 +845,8 @@ impl Preprocessor {
Ok(clause_to_query_term(
loader,
name,
terms,
atom!("call"),
vec![Term::Clause(r, name, terms)],
self.settings.default_call_policy(),
))
}

205
src/machine/streams.rs
View File

@@ -26,6 +26,7 @@ use std::ops::{Deref, DerefMut};
use std::ptr;
use native_tls::TlsStream;
use hyper::body::{Bytes, Sender};
#[derive(Debug, BitfieldSpecifier, Clone, Copy, PartialEq, Eq, Hash)]
#[bits = 1]
@@ -249,24 +250,51 @@ impl Write for NamedTlsStream {
}
}
pub struct NamedHttpClientStream {
pub struct HttpReadStream {
url: Atom,
body_reader: Box<dyn BufRead>,
}
impl Debug for NamedHttpClientStream {
impl Debug for HttpReadStream {
fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result {
write!(f, "Http Client Stream [{}]", self.url.as_str())
write!(f, "Http Read Stream [{}]", self.url.as_str())
}
}
impl Read for NamedHttpClientStream {
impl Read for HttpReadStream {
#[inline]
fn read(&mut self, buf: &mut [u8]) -> std::io::Result<usize> {
self.body_reader.read(buf)
}
}
pub struct HttpWriteStream {
body_writer: Sender,
}
impl Debug for HttpWriteStream {
fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result {
write!(f, "Http Write Stream")
}
}
impl Write for HttpWriteStream {
#[inline]
fn write(&mut self, buf: &[u8]) -> std::io::Result<usize> {
let bytes = Bytes::copy_from_slice(buf);
let len = bytes.len();
match self.body_writer.try_send_data(bytes) {
Ok(()) => Ok(len),
Err(_) => Err(std::io::Error::from(ErrorKind::Interrupted))
}
}
#[inline]
fn flush(&mut self) -> std::io::Result<()> {
Ok(())
}
}
#[derive(Debug)]
pub struct StandardOutputStream {}
@@ -405,7 +433,8 @@ arena_allocated_impl_for_stream!(CharReader<InputFileStream>, InputFileStream);
arena_allocated_impl_for_stream!(OutputFileStream, OutputFileStream);
arena_allocated_impl_for_stream!(CharReader<NamedTcpStream>, NamedTcpStream);
arena_allocated_impl_for_stream!(CharReader<NamedTlsStream>, NamedTlsStream);
arena_allocated_impl_for_stream!(CharReader<NamedHttpClientStream>, NamedHttpClientStream);
arena_allocated_impl_for_stream!(CharReader<HttpReadStream>, HttpReadStream);
arena_allocated_impl_for_stream!(CharReader<HttpWriteStream>, HttpWriteStream);
arena_allocated_impl_for_stream!(ReadlineStream, ReadlineStream);
arena_allocated_impl_for_stream!(StaticStringStream, StaticStringStream);
arena_allocated_impl_for_stream!(StandardOutputStream, StandardOutputStream);
@@ -419,7 +448,8 @@ pub enum Stream {
StaticString(TypedArenaPtr<StreamLayout<StaticStringStream>>),
NamedTcp(TypedArenaPtr<StreamLayout<CharReader<NamedTcpStream>>>),
NamedTls(TypedArenaPtr<StreamLayout<CharReader<NamedTlsStream>>>),
NamedHttpClient(TypedArenaPtr<StreamLayout<CharReader<NamedHttpClientStream>>>),
HttpRead(TypedArenaPtr<StreamLayout<CharReader<HttpReadStream>>>),
HttpWrite(TypedArenaPtr<StreamLayout<CharReader<HttpWriteStream>>>),
Null(StreamOptions),
Readline(TypedArenaPtr<StreamLayout<ReadlineStream>>),
StandardOutput(TypedArenaPtr<StreamLayout<StandardOutputStream>>),
@@ -474,7 +504,8 @@ impl Stream {
}
ArenaHeaderTag::NamedTcpStream => Stream::NamedTcp(TypedArenaPtr::new(ptr as *mut _)),
ArenaHeaderTag::NamedTlsStream => Stream::NamedTls(TypedArenaPtr::new(ptr as *mut _)),
ArenaHeaderTag::NamedHttpClientStream => Stream::NamedHttpClient(TypedArenaPtr::new(ptr as *mut _)),
ArenaHeaderTag::HttpReadStream => Stream::HttpRead(TypedArenaPtr::new(ptr as *mut _)),
ArenaHeaderTag::HttpWriteStream => Stream::HttpWrite(TypedArenaPtr::new(ptr as *mut _)),
ArenaHeaderTag::ReadlineStream => Stream::Readline(TypedArenaPtr::new(ptr as *mut _)),
ArenaHeaderTag::StaticStringStream => {
Stream::StaticString(TypedArenaPtr::new(ptr as *mut _))
@@ -527,7 +558,8 @@ impl Stream {
Stream::StaticString(ptr) => ptr.header_ptr(),
Stream::NamedTcp(ptr) => ptr.header_ptr(),
Stream::NamedTls(ptr) => ptr.header_ptr(),
Stream::NamedHttpClient(ptr) => ptr.header_ptr(),
Stream::HttpRead(ptr) => ptr.header_ptr(),
Stream::HttpWrite(ptr) => ptr.header_ptr(),
Stream::Null(_) => ptr::null(),
Stream::Readline(ptr) => ptr.header_ptr(),
Stream::StandardOutput(ptr) => ptr.header_ptr(),
@@ -543,7 +575,8 @@ impl Stream {
Stream::StaticString(ref ptr) => &ptr.options,
Stream::NamedTcp(ref ptr) => &ptr.options,
Stream::NamedTls(ref ptr) => &ptr.options,
Stream::NamedHttpClient(ref ptr) => &ptr.options,
Stream::HttpRead(ref ptr) => &ptr.options,
Stream::HttpWrite(ref ptr) => &ptr.options,
Stream::Null(ref options) => options,
Stream::Readline(ref ptr) => &ptr.options,
Stream::StandardOutput(ref ptr) => &ptr.options,
@@ -559,7 +592,8 @@ impl Stream {
Stream::StaticString(ref mut ptr) => &mut ptr.options,
Stream::NamedTcp(ref mut ptr) => &mut ptr.options,
Stream::NamedTls(ref mut ptr) => &mut ptr.options,
Stream::NamedHttpClient(ref mut ptr) => &mut ptr.options,
Stream::HttpRead(ref mut ptr) => &mut ptr.options,
Stream::HttpWrite(ref mut ptr) => &mut ptr.options,
Stream::Null(ref mut options) => options,
Stream::Readline(ref mut ptr) => &mut ptr.options,
Stream::StandardOutput(ref mut ptr) => &mut ptr.options,
@@ -576,7 +610,8 @@ impl Stream {
Stream::StaticString(ptr) => ptr.lines_read += incr_num_lines_read,
Stream::NamedTcp(ptr) => ptr.lines_read += incr_num_lines_read,
Stream::NamedTls(ptr) => ptr.lines_read += incr_num_lines_read,
Stream::NamedHttpClient(ptr) => ptr.lines_read += incr_num_lines_read,
Stream::HttpRead(ptr) => ptr.lines_read += incr_num_lines_read,
Stream::HttpWrite(_) => {}
Stream::Null(_) => {}
Stream::Readline(ptr) => ptr.lines_read += incr_num_lines_read,
Stream::StandardOutput(ptr) => ptr.lines_read += incr_num_lines_read,
@@ -593,7 +628,8 @@ impl Stream {
Stream::StaticString(ptr) => ptr.lines_read = value,
Stream::NamedTcp(ptr) => ptr.lines_read = value,
Stream::NamedTls(ptr) => ptr.lines_read = value,
Stream::NamedHttpClient(ptr) => ptr.lines_read = value,
Stream::HttpRead(ptr) => ptr.lines_read = value,
Stream::HttpWrite(_) => {}
Stream::Null(_) => {}
Stream::Readline(ptr) => ptr.lines_read = value,
Stream::StandardOutput(ptr) => ptr.lines_read = value,
@@ -610,7 +646,8 @@ impl Stream {
Stream::StaticString(ptr) => ptr.lines_read,
Stream::NamedTcp(ptr) => ptr.lines_read,
Stream::NamedTls(ptr) => ptr.lines_read,
Stream::NamedHttpClient(ptr) => ptr.lines_read,
Stream::HttpRead(ptr) => ptr.lines_read,
Stream::HttpWrite(_) => 0,
Stream::Null(_) => 0,
Stream::Readline(ptr) => ptr.lines_read,
Stream::StandardOutput(ptr) => ptr.lines_read,
@@ -625,13 +662,14 @@ impl CharRead for Stream {
Stream::InputFile(file) => (*file).peek_char(),
Stream::NamedTcp(tcp_stream) => (*tcp_stream).peek_char(),
Stream::NamedTls(tls_stream) => (*tls_stream).peek_char(),
Stream::NamedHttpClient(http_stream) => (*http_stream).peek_char(),
Stream::HttpRead(http_stream) => (*http_stream).peek_char(),
Stream::Readline(rl_stream) => (*rl_stream).peek_char(),
Stream::StaticString(src) => (*src).peek_char(),
Stream::Byte(cursor) => (*cursor).peek_char(),
Stream::OutputFile(_) |
Stream::StandardError(_) |
Stream::StandardOutput(_) |
Stream::HttpWrite(_) |
Stream::Null(_) => Some(Err(std::io::Error::new(
ErrorKind::PermissionDenied,
StreamError::ReadFromOutputStream,
@@ -644,13 +682,14 @@ impl CharRead for Stream {
Stream::InputFile(file) => (*file).read_char(),
Stream::NamedTcp(tcp_stream) => (*tcp_stream).read_char(),
Stream::NamedTls(tls_stream) => (*tls_stream).read_char(),
Stream::NamedHttpClient(http_stream) => (*http_stream).read_char(),
Stream::HttpRead(http_stream) => (*http_stream).read_char(),
Stream::Readline(rl_stream) => (*rl_stream).read_char(),
Stream::StaticString(src) => (*src).read_char(),
Stream::Byte(cursor) => (*cursor).read_char(),
Stream::OutputFile(_) |
Stream::StandardError(_) |
Stream::StandardOutput(_) |
Stream::HttpWrite(_) |
Stream::Null(_) => Some(Err(std::io::Error::new(
ErrorKind::PermissionDenied,
StreamError::ReadFromOutputStream,
@@ -663,13 +702,14 @@ impl CharRead for Stream {
Stream::InputFile(file) => file.put_back_char(c),
Stream::NamedTcp(tcp_stream) => tcp_stream.put_back_char(c),
Stream::NamedTls(tls_stream) => tls_stream.put_back_char(c),
Stream::NamedHttpClient(http_stream) => http_stream.put_back_char(c),
Stream::HttpRead(http_stream) => http_stream.put_back_char(c),
Stream::Readline(rl_stream) => rl_stream.put_back_char(c),
Stream::StaticString(src) => src.put_back_char(c),
Stream::Byte(cursor) => cursor.put_back_char(c),
Stream::OutputFile(_) |
Stream::StandardError(_) |
Stream::StandardOutput(_) |
Stream::HttpWrite(_) |
Stream::Null(_) => {}
}
}
@@ -679,13 +719,14 @@ impl CharRead for Stream {
Stream::InputFile(ref mut file) => file.consume(nread),
Stream::NamedTcp(ref mut tcp_stream) => tcp_stream.consume(nread),
Stream::NamedTls(ref mut tls_stream) => tls_stream.consume(nread),
Stream::NamedHttpClient(ref mut http_stream) => http_stream.consume(nread),
Stream::HttpRead(ref mut http_stream) => http_stream.consume(nread),
Stream::Readline(ref mut rl_stream) => rl_stream.consume(nread),
Stream::StaticString(ref mut src) => src.consume(nread),
Stream::Byte(ref mut cursor) => cursor.consume(nread),
Stream::OutputFile(_) |
Stream::StandardError(_) |
Stream::StandardOutput(_) |
Stream::HttpWrite(_) |
Stream::Null(_) => {}
}
}
@@ -698,13 +739,14 @@ impl Read for Stream {
Stream::InputFile(file) => (*file).read(buf),
Stream::NamedTcp(tcp_stream) => (*tcp_stream).read(buf),
Stream::NamedTls(tls_stream) => (*tls_stream).read(buf),
Stream::NamedHttpClient(http_stream) => (*http_stream).read(buf),
Stream::HttpRead(http_stream) => (*http_stream).read(buf),
Stream::Readline(rl_stream) => (*rl_stream).read(buf),
Stream::StaticString(src) => (*src).read(buf),
Stream::Byte(cursor) => (*cursor).read(buf),
Stream::OutputFile(_)
| Stream::StandardError(_)
| Stream::StandardOutput(_)
| Stream::StandardOutput(_)
| Stream::HttpWrite(_)
| Stream::Null(_) => Err(std::io::Error::new(
ErrorKind::PermissionDenied,
StreamError::ReadFromOutputStream,
@@ -724,7 +766,8 @@ impl Write for Stream {
Stream::Byte(ref mut cursor) => cursor.get_mut().write(buf),
Stream::StandardOutput(stream) => stream.write(buf),
Stream::StandardError(stream) => stream.write(buf),
Stream::NamedHttpClient(_) |
Stream::HttpWrite(ref mut stream) => stream.get_mut().write(buf),
Stream::HttpRead(_) |
Stream::StaticString(_) |
Stream::Readline(_) |
Stream::InputFile(..) |
@@ -743,7 +786,8 @@ impl Write for Stream {
Stream::Byte(ref mut cursor) => cursor.stream.get_mut().flush(),
Stream::StandardError(stream) => stream.stream.flush(),
Stream::StandardOutput(stream) => stream.stream.flush(),
Stream::NamedHttpClient(_) |
Stream::HttpWrite(ref mut stream) => stream.stream.get_mut().flush(),
Stream::HttpRead(_) |
Stream::StaticString(_) |
Stream::Readline(_) |
Stream::InputFile(_) |
@@ -868,7 +912,8 @@ impl Stream {
Stream::StaticString(stream) => stream.past_end_of_stream,
Stream::NamedTcp(stream) => stream.past_end_of_stream,
Stream::NamedTls(stream) => stream.past_end_of_stream,
Stream::NamedHttpClient(stream) => stream.past_end_of_stream,
Stream::HttpRead(stream) => stream.past_end_of_stream,
Stream::HttpWrite(stream) => stream.past_end_of_stream,
Stream::Null(_) => false,
Stream::Readline(stream) => stream.past_end_of_stream,
Stream::StandardOutput(stream) => stream.past_end_of_stream,
@@ -890,7 +935,8 @@ impl Stream {
Stream::StaticString(stream) => stream.past_end_of_stream = value,
Stream::NamedTcp(stream) => stream.past_end_of_stream = value,
Stream::NamedTls(stream) => stream.past_end_of_stream = value,
Stream::NamedHttpClient(stream) => stream.past_end_of_stream = value,
Stream::HttpRead(stream) => stream.past_end_of_stream = value,
Stream::HttpWrite(stream) => stream.past_end_of_stream = value,
Stream::Null(_) => {}
Stream::Readline(stream) => stream.past_end_of_stream = value,
Stream::StandardOutput(stream) => stream.past_end_of_stream = value,
@@ -956,11 +1002,11 @@ impl Stream {
Stream::Byte(_)
| Stream::Readline(_)
| Stream::StaticString(_)
| Stream::NamedHttpClient(_)
| Stream::HttpRead(_)
| Stream::InputFile(..) => atom!("read"),
Stream::NamedTcp(..) | Stream::NamedTls(..) => atom!("read_append"),
Stream::OutputFile(file) if file.is_append => atom!("append"),
Stream::OutputFile(_) | Stream::StandardError(_) | Stream::StandardOutput(_) => atom!("write"),
Stream::OutputFile(_) | Stream::StandardError(_) | Stream::StandardOutput(_) | Stream::HttpWrite(_) => atom!("write"),
Stream::Null(_) => atom!(""),
}
}
@@ -1020,8 +1066,8 @@ impl Stream {
http_stream: Box<dyn BufRead>,
arena: &mut Arena,
) -> Self {
Stream::NamedHttpClient(arena_alloc!(
StreamLayout::new(CharReader::new(NamedHttpClientStream {
Stream::HttpRead(arena_alloc!(
StreamLayout::new(CharReader::new(HttpReadStream {
url,
body_reader: http_stream
})),
@@ -1029,6 +1075,19 @@ impl Stream {
))
}
#[inline]
pub(crate) fn from_http_sender(
body_writer: Sender,
arena: &mut Arena,
) -> Self {
Stream::HttpWrite(arena_alloc!(
StreamLayout::new(CharReader::new(HttpWriteStream {
body_writer
})),
arena
))
}
#[inline]
pub(crate) fn from_file_as_output(
file_name: Atom,
@@ -1065,7 +1124,7 @@ impl Stream {
Stream::NamedTls(ref mut tls_stream) => {
tls_stream.inner_mut().tls_stream.shutdown()
}
Stream::NamedHttpClient(ref mut http_stream) => {
Stream::HttpRead(ref mut http_stream) => {
unsafe {
http_stream.set_tag(ArenaHeaderTag::Dropped);
std::ptr::drop_in_place(&mut http_stream.inner_mut().body_reader as *mut _);
@@ -1073,6 +1132,14 @@ impl Stream {
Ok(())
}
Stream::HttpWrite(ref mut http_stream) => {
unsafe {
http_stream.set_tag(ArenaHeaderTag::Dropped);
std::ptr::drop_in_place(&mut http_stream.inner_mut().body_writer as *mut _);
}
Ok(())
}
Stream::InputFile(mut file_stream) => {
// close the stream by dropping the inner File.
unsafe {
@@ -1109,7 +1176,7 @@ impl Stream {
match self {
Stream::NamedTcp(..)
| Stream::NamedTls(..)
| Stream::NamedHttpClient(..)
| Stream::HttpRead(..)
| Stream::Byte(_)
| Stream::Readline(_)
| Stream::StaticString(_)
@@ -1124,7 +1191,8 @@ impl Stream {
Stream::StandardError(_)
| Stream::StandardOutput(_)
| Stream::NamedTcp(..)
| Stream::NamedTls(..)
| Stream::NamedTls(..)
| Stream::HttpWrite(..)
| Stream::Byte(_)
| Stream::OutputFile(..) => true,
_ => false,
@@ -1254,6 +1322,18 @@ impl MachineState {
None
}
}
(HeapCellValueTag::Str, s) => {
let (name, arity) = cell_as_atom_cell!(self.heap[s])
.get_name_and_arity();
debug_assert_eq!(arity, 0);
if name != atom!("[]") {
Some(name)
} else {
None
}
}
_ => {
None
}
@@ -1270,6 +1350,19 @@ impl MachineState {
_ => unreachable!(),
}
}
(HeapCellValueTag::Str, s) => {
let (name, arity) = cell_as_atom_cell!(self.heap[s])
.get_name_and_arity();
debug_assert_eq!(arity, 0);
match name {
atom!("eof_code") => EOFAction::EOFCode,
atom!("error") => EOFAction::Error,
atom!("reset") => EOFAction::Reset,
_ => unreachable!(),
}
}
_ => {
unreachable!()
}
@@ -1280,6 +1373,13 @@ impl MachineState {
debug_assert_eq!(arity, 0);
name == atom!("true")
}
(HeapCellValueTag::Str, s) => {
let (name, arity) = cell_as_atom_cell!(self.heap[s])
.get_name_and_arity();
debug_assert_eq!(arity, 0);
name == atom!("true")
}
_ => {
unreachable!()
}
@@ -1294,6 +1394,17 @@ impl MachineState {
_ => unreachable!(),
}
}
(HeapCellValueTag::Str, s) => {
let (name, arity) = cell_as_atom_cell!(self.heap[s])
.get_name_and_arity();
debug_assert_eq!(arity, 0);
match name {
atom!("text") => StreamType::Text,
atom!("binary") => StreamType::Binary,
_ => unreachable!(),
}
}
_ => {
unreachable!()
}
@@ -1334,6 +1445,24 @@ impl MachineState {
}
};
}
(HeapCellValueTag::Str, s) => {
let (name, arity) = cell_as_atom_cell!(self.heap[s])
.get_name_and_arity();
debug_assert_eq!(arity, 0);
return match stream_aliases.get(&name) {
Some(stream) if !stream.is_null_stream() => Ok(*stream),
_ => {
let stub = functor_stub(caller, arity);
let addr = atom_as_cell!(name);
let existence_error = self.existence_error(ExistenceError::Stream(addr));
Err(self.error_form(existence_error, stub))
}
};
}
(HeapCellValueTag::Cons, ptr) => {
match_untyped_arena_ptr!(ptr,
(ArenaHeaderTag::Stream, stream) => {
@@ -1402,9 +1531,9 @@ impl MachineState {
arity: usize,
) -> MachineStub {
let stub = functor_stub(caller, arity);
let err = self.permission_error(perm, err_atom, stream_as_cell!(stream));
let err = self.permission_error(perm, err_atom, stream_as_cell!(stream));
return self.error_form(err, stub);
self.error_form(err, stub)
}
#[inline]
@@ -1430,9 +1559,9 @@ impl MachineState {
stub_arity: usize,
) -> MachineStub {
let stub = functor_stub(stub_name, stub_arity);
let err = self.permission_error(Permission::Open, atom!("source_sink"), culprit);
let err = self.permission_error(Permission::Open, atom!("source_sink"), culprit);
return self.error_form(err, stub);
self.error_form(err, stub)
}
pub(crate) fn occupied_alias_permission_error(
@@ -1442,24 +1571,22 @@ impl MachineState {
stub_arity: usize,
) -> MachineStub {
let stub = functor_stub(stub_name, stub_arity);
let alias_name = atom!("alias");
let err = self.permission_error(
Permission::Open,
atom!("source_sink"),
functor!(alias_name, [atom(alias)]),
functor!(atom!("alias"), [atom(alias)]),
);
return self.error_form(err, stub);
self.error_form(err, stub)
}
pub(crate) fn reposition_error(&mut self, stub_name: Atom, stub_arity: usize) -> MachineStub {
let stub = functor_stub(stub_name, stub_arity);
let rep_stub = functor!(atom!("reposition"), [atom(atom!("true"))]);
let err = self.permission_error(Permission::Open, atom!("source_sink"), rep_stub);
return self.error_form(err, stub);
self.error_form(err, stub)
}
pub(crate) fn check_stream_properties(

989
src/machine/system_calls.rs
View File

File diff suppressed because it is too large Load Diff

18
src/machine/term_stream.rs
View File

@@ -119,3 +119,21 @@ impl TermStream for LiveTermStream {
&self.listing_src
}
}
pub struct InlineTermStream {
}
impl TermStream for InlineTermStream {
fn next(&mut self, _: &CompositeOpDir) -> Result<Term, CompilationError> {
Err(CompilationError::from(ParserError::UnexpectedEOF))
}
fn eof(&mut self) -> Result<bool, CompilationError> {
Ok(true)
}
fn listing_src(&self) -> &ListingSource {
&ListingSource::User
}
}

29
src/macros.rs
View File

@@ -272,6 +272,26 @@ macro_rules! match_untyped_arena_ptr_pat_body {
#[allow(unused_braces)]
$code
}};
($ptr:ident, HttpListener, $listener:ident, $code:expr) => {{
let payload_ptr = unsafe { std::mem::transmute::<_, *mut HttpListener>($ptr.payload_offset()) };
#[allow(unused_mut)]
let mut $listener = TypedArenaPtr::new(payload_ptr);
#[allow(unused_braces)]
$code
}};
($ptr:ident, HttpResponse, $listener:ident, $code:expr) => {{
let payload_ptr = unsafe { std::mem::transmute::<_, *mut HttpResponse>($ptr.payload_offset()) };
#[allow(unused_mut)]
let mut $listener = TypedArenaPtr::new(payload_ptr);
#[allow(unused_braces)]
$code
}};
($ptr:ident, IndexPtr, $ip:ident, $code:expr) => {{
#[allow(unused_mut)]
let mut $ip = TypedArenaPtr::new(unsafe { std::mem::transmute::<_, *mut IndexPtr>($ptr.get_ptr()) });
#[allow(unused_braces)]
$code
}};
($ptr:ident, $($tags:tt)|+, $s:ident, $code:expr) => {{
let $s = Stream::from_tag($ptr.get_tag(), $ptr.payload_offset());
#[allow(unused_braces)]
@@ -285,13 +305,20 @@ macro_rules! match_untyped_arena_ptr_pat {
| ArenaHeaderTag::OutputFileStream
| ArenaHeaderTag::NamedTcpStream
| ArenaHeaderTag::NamedTlsStream
| ArenaHeaderTag::NamedHttpClientStream
| ArenaHeaderTag::HttpReadStream
| ArenaHeaderTag::HttpWriteStream
| ArenaHeaderTag::ReadlineStream
| ArenaHeaderTag::StaticStringStream
| ArenaHeaderTag::ByteStream
| ArenaHeaderTag::StandardOutputStream
| ArenaHeaderTag::StandardErrorStream
};
(IndexPtr) => {
ArenaHeaderTag::IndexPtrUndefined |
ArenaHeaderTag::IndexPtrDynamicUndefined |
ArenaHeaderTag::IndexPtrDynamicIndex |
ArenaHeaderTag::IndexPtrIndex
};
($tag:ident) => {
ArenaHeaderTag::$tag
};

3
src/parser/ast.rs
View File

@@ -1,5 +1,6 @@
use crate::arena::*;
use crate::atom_table::*;
use crate::machine::machine_indices::*;
use crate::parser::char_reader::*;
use crate::types::HeapCellValueTag;
@@ -530,6 +531,7 @@ impl Neg for Fixnum {
pub enum Literal {
Atom(Atom),
Char(char),
CodeIndex(CodeIndex),
Fixnum(Fixnum),
Integer(TypedArenaPtr<Integer>),
Rational(TypedArenaPtr<Rational>),
@@ -551,6 +553,7 @@ impl fmt::Display for Literal {
write!(f, "{}", atom.flat_index())
}
Literal::Char(c) => write!(f, "'{}'", *c as u32),
Literal::CodeIndex(i) => write!(f, "{:x}", i.as_ptr() as u64),
Literal::Fixnum(n) => write!(f, "{}", n.get_num()),
Literal::Integer(ref n) => write!(f, "{}", n),
Literal::Rational(ref n) => write!(f, "{}", n),

1
src/parser/lexer.rs
View File

@@ -1,5 +1,6 @@
use lexical::parse_lossy;
use crate::arena::ArenaAllocated;
use crate::atom_table::*;
pub use crate::machine::machine_state::*;
use crate::parser::ast::*;

14
src/read.rs
View File

@@ -336,7 +336,7 @@ impl<'a, 'b> TermWriter<'a, 'b> {
self.push_stub_addr();
self.push_stub_addr();
}
&TermRef::Clause(Level::Root, _, ref ct, subterms) => {
&TermRef::Clause(Level::Root, _, name, subterms) => {
if subterms.len() > MAX_ARITY {
return Err(CompilationError::ExceededMaxArity);
}
@@ -348,7 +348,7 @@ impl<'a, 'b> TermWriter<'a, 'b> {
});
self.queue.push_back((subterms.len(), h + 2));
let named = atom_as_cell!(ct.name(), subterms.len());
let named = atom_as_cell!(name, subterms.len());
self.heap.push(named);
@@ -358,9 +358,9 @@ impl<'a, 'b> TermWriter<'a, 'b> {
continue;
}
&TermRef::Clause(_, _, ref ct, subterms) => {
&TermRef::Clause(_, _, name, subterms) => {
self.queue.push_back((subterms.len(), h + 1));
let named = atom_as_cell!(ct.name(), subterms.len());
let named = atom_as_cell!(name, subterms.len());
self.heap.push(named);
@@ -390,6 +390,12 @@ impl<'a, 'b> TermWriter<'a, 'b> {
put_complete_string(self.heap, src.as_str(), self.atom_tbl);
}
&TermRef::PartialString(lvl, _, ref src, _) => {
if let Level::Root = lvl {
// Var tags can't refer directly to partial strings,
// so a PStrLoc cell must be pushed.
self.heap.push(pstr_loc_as_cell!(heap_loc + 1));
}
allocate_pstr(self.heap, src.as_str(), self.atom_tbl);
let h = self.heap.len();

17
src/toplevel.pl
View File

@@ -172,7 +172,7 @@ instruction_match(Term, VarList) :-
; Term = end_of_file ->
halt
;
submit_query_and_print_results(Term, VarList)
submit_query_and_print_results(Term, VarList)
).
@@ -180,7 +180,7 @@ submit_query_and_print_results_(Term, VarList) :-
'$get_b_value'(B),
bb_put('$report_all', false),
bb_put('$report_n_more', 0),
'$call'(Term),
call(user:Term),
write_eqs_and_read_input(B, VarList),
!.
submit_query_and_print_results_(_, _) :-
@@ -192,12 +192,12 @@ submit_query_and_print_results_(_, _) :-
nl.
submit_query_and_print_results(Term0, VarList) :-
( functor(Term0, call, _) ->
Term = Term0 % prevent pre-mature expansion of incomplete goal
% in the first argument, which is done by call/N
; expand_goal(Term0, user, Term)
),
submit_query_and_print_results(Term, VarList) :-
% ( functor(Term0, call, _) ->
% Term = Term0 % prevent pre-mature expansion of incomplete goal
% % in the first argument, which is done by call/N
% ; expand_goal(Term0, user, Term)
% ),
bb_put('$answer_count', 0),
submit_query_and_print_results_(Term, VarList).
@@ -301,6 +301,7 @@ write_eqs_and_read_input(B, VarList) :-
append(Equations, AttrGoals, Goals),
% one layer of depth added for (=/2) functor
maplist(\Term^Vs^term_variables_under_max_depth(Term, 22, Vs), Equations, EquationVars),
% maplist(term_variables_under_max_depth(22), Equations, EquationVars),
append([AttrGoalVars | EquationVars], Vars1),
term_variables(Vars1, Vars2), % deduplicate vars of Vars1 but preserve their order.
charsio:extend_var_list(Vars2, VarList, NewVarList0, fabricated),

51
src/types.rs
View File

@@ -301,7 +301,7 @@ impl fmt::Debug for HeapCellValue {
}
}
impl<T> From<TypedArenaPtr<T>> for HeapCellValue {
impl<T: ArenaAllocated> From<TypedArenaPtr<T>> for HeapCellValue {
#[inline]
fn from(arena_ptr: TypedArenaPtr<T>) -> HeapCellValue {
HeapCellValue::from(arena_ptr.header_ptr() as u64)
@@ -441,20 +441,22 @@ impl HeapCellValue {
}
#[inline]
pub fn is_compound(self) -> bool {
pub fn is_compound(self, heap: &[HeapCellValue]) -> bool {
match self.get_tag() {
HeapCellValueTag::Str
| HeapCellValueTag::Lis
| HeapCellValueTag::CStr
| HeapCellValueTag::PStr
| HeapCellValueTag::PStrLoc
| HeapCellValueTag::PStrOffset => {
HeapCellValueTag::Str => {
cell_as_atom_cell!(heap[self.get_value()]).get_arity() > 0
}
HeapCellValueTag::Lis |
HeapCellValueTag::CStr |
HeapCellValueTag::PStr |
HeapCellValueTag::PStrLoc |
HeapCellValueTag::PStrOffset => {
true
}
HeapCellValueTag::Atom => {
cell_as_atom_cell!(self).get_arity() > 0
}
_ => { false }
}
HeapCellValueTag::Atom => {
cell_as_atom_cell!(self).get_arity() > 0
}
_ => { false }
}
}
@@ -582,7 +584,7 @@ impl HeapCellValue {
}
}
pub fn order_category(self) -> Option<TermOrderCategory> {
pub fn order_category(self, heap: &[HeapCellValue]) -> Option<TermOrderCategory> {
match Number::try_from(self).ok() {
Some(Number::Integer(_)) | Some(Number::Fixnum(_)) | Some(Number::Rational(_)) => {
Some(TermOrderCategory::Integer)
@@ -601,9 +603,19 @@ impl HeapCellValue {
})
}
HeapCellValueTag::Lis | HeapCellValueTag::PStrLoc |
HeapCellValueTag::CStr | HeapCellValueTag::Str => {
HeapCellValueTag::CStr => {
Some(TermOrderCategory::Compound)
}
HeapCellValueTag::Str => {
let value = heap[self.get_value()];
let arity = cell_as_atom_cell!(value).get_arity();
if arity == 0 {
Some(TermOrderCategory::Atom)
} else {
Some(TermOrderCategory::Compound)
}
}
_ => {
None
}
@@ -628,7 +640,7 @@ const_assert!(mem::size_of::<HeapCellValue>() == 8);
#[bitfield]
#[repr(u64)]
#[derive(Copy, Clone, Debug)]
#[derive(Copy, Clone, Debug, Hash, PartialEq, Eq)]
pub struct UntypedArenaPtr {
ptr: B61,
m: bool,
@@ -644,6 +656,13 @@ impl From<*const ArenaHeader> for UntypedArenaPtr {
}
}
impl From<*const IndexPtr> for UntypedArenaPtr {
#[inline]
fn from(ptr: *const IndexPtr) -> UntypedArenaPtr {
unsafe { mem::transmute(ptr) }
}
}
impl From<UntypedArenaPtr> for *const ArenaHeader {
#[inline]
fn from(ptr: UntypedArenaPtr) -> *const ArenaHeader {