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

use new heap term representation

Browse Source
This commit is contained in:
Mark Thom
2021-11-14 13:39:56 -07:00
parent d0b74a95f4
commit 0404c3bd94
72 changed files with 26285 additions and 17019 deletions
Download Patch File Download Diff File Expand all files Collapse all files

52
src/lib/atts.pl
View File

@@ -24,30 +24,42 @@
'$absent_from_list'(Ls, Attr).
'$absent_from_list'(X, Attr) :-
( var(X) -> true
; X = [L|Ls], L \= Attr -> '$absent_from_list'(Ls, Attr)
( var(X) ->
true
; X = [L|Ls],
L \= Attr ->
'$absent_from_list'(Ls, Attr)
).
'$get_attr'(V, Attr) :-
'$get_attr_list'(V, Ls), nonvar(Ls), '$get_from_list'(Ls, V, Attr).
'$get_attr_list'(V, Ls),
nonvar(Ls),
'$get_from_list'(Ls, V, Attr).
'$get_from_list'([L|Ls], V, Attr) :-
nonvar(L),
( L \= Attr -> nonvar(Ls), '$get_from_list'(Ls, V, Attr)
; L = Attr, '$enqueue_attr_var'(V)
( L \= Attr ->
nonvar(Ls),
'$get_from_list'(Ls, V, Attr)
; L = Attr,
'$enqueue_attr_var'(V)
).
'$put_attr'(V, Attr) :-
'$get_attr_list'(V, Ls), '$add_to_list'(Ls, V, Attr).
'$get_attr_list'(V, Ls),
'$add_to_list'(Ls, V, Attr).
'$add_to_list'(Ls, V, Attr) :-
( var(Ls) ->
Ls = [Attr | _], '$enqueue_attr_var'(V)
; Ls = [_ | Ls0], '$add_to_list'(Ls0, V, Attr)
( var(Ls) ->
Ls = [Attr | _],
'$enqueue_attr_var'(V)
; Ls = [_ | Ls0],
'$add_to_list'(Ls0, V, Attr)
).
'$del_attr'(Ls0, _, _) :-
var(Ls0), !.
var(Ls0),
!.
'$del_attr'(Ls0, V, Attr) :-
Ls0 = [Att | Ls1],
nonvar(Att),
@@ -134,22 +146,22 @@ put_attr(Name, Arity, Module) -->
[(put_atts(V, +Attr) :-
!,
functor(Attr, Head, Arity),
functor(AttrForm, Head, Arity),
'$get_attr_list'(V, Ls),
atts:'$del_attr'(Ls, V, Module:AttrForm),
atts:'$put_attr'(V, Module:Attr)),
functor(AttrForm, Head, Arity),
'$get_attr_list'(V, Ls),
atts:'$del_attr'(Ls, V, Module:AttrForm),
atts:'$put_attr'(V, Module:Attr)),
(put_atts(V, Attr) :-
!,
functor(Attr, Head, Arity),
functor(AttrForm, Head, Arity),
'$get_attr_list'(V, Ls),
atts:'$del_attr'(Ls, V, Module:AttrForm),
atts:'$put_attr'(V, Module:Attr)),
functor(AttrForm, Head, Arity),
'$get_attr_list'(V, Ls),
atts:'$del_attr'(Ls, V, Module:AttrForm),
atts:'$put_attr'(V, Module:Attr)),
(put_atts(V, -Attr) :-
!,
functor(Attr, _, _),
'$get_attr_list'(V, Ls),
atts:'$del_attr'(Ls, V, Module:Attr))].
'$get_attr_list'(V, Ls),
atts:'$del_attr'(Ls, V, Module:Attr))].
get_attr(Name, Arity, Module) -->
{ functor(Attr, Name, Arity) },

17
src/lib/between.pl
View File

@@ -12,10 +12,22 @@ between(Lower, Upper, X) :-
( nonvar(X) ->
Lower =< X,
X =< Upper
; compare(Ord, Lower, Upper),
between_(Ord, Lower, Upper, X)
; % compare(Ord, Lower, Upper),
% between_(Ord, Lower, Upper, X)
Lower =< Upper,
between_(Lower, Upper, X)
).
between_(Lower, Lower, Lower) :- !.
between_(Lower, Upper, Lower1) :-
( Lower < Upper,
( Lower1 = Lower
; Lower0 is Lower + 1,
between_(Lower0, Upper, Lower1)
)
).
/*
between_(<, Lower0, Upper, X) :-
( X = Lower0
; Lower1 is Lower0 + 1,
@@ -23,6 +35,7 @@ between_(<, Lower0, Upper, X) :-
between_(Ord, Lower1, Upper, X)
).
between_(=, Upper, Upper, Upper).
*/
enumerate_nats(I, I).
enumerate_nats(I0, N) :-

51
src/lib/builtins.pl
View File

@@ -347,11 +347,11 @@ call_or_cut_interp((G1 -> G2), B) :-
:- non_counted_backtracking univ_errors/3.
univ_errors(Term, List, N) :-
'$skip_max_list'(N, -1, List, R),
( var(R) ->
( var(Term),
throw(error(instantiation_error, (=..)/2)) % 8.5.3.3 a)
; true
)
( var(R) ->
( var(Term),
throw(error(instantiation_error, (=..)/2)) % 8.5.3.3 a)
; true
)
; R \== [] ->
throw(error(type_error(list, List), (=..)/2)) % 8.5.3.3 b)
; List = [H|T] ->
@@ -388,9 +388,10 @@ univ_worker(Term, List, _) :-
!,
'$call_with_default_policy'(List = [Term]).
univ_worker(Term, [Name|Args], N) :-
var(Term), !,
var(Term),
!,
'$call_with_default_policy'(Arity is N-1),
'$call_with_default_policy'(functor(Term, Name, Arity)),
'$call_with_default_policy'(functor(Term, Name, Arity)), % Term = {var}, Name = nonvar, Arity = 0.
'$call_with_default_policy'(get_args(Args, Term, 1, Arity)).
univ_worker(Term, List, _) :-
'$call_with_default_policy'(functor(Term, Name, Arity)),
@@ -679,9 +680,9 @@ set_difference([], _, []) :- !.
set_difference(Xs, [], Xs).
group_by_variant([V2-S2 | Pairs], V1-S1, [S2 | Solutions], Pairs0) :-
iso_ext:variant(V1, V2),
V1 = V2, % \+ \+ (V1 = V2), % (2) % iso_ext:variant(V1, V2), % (1)
!,
V1 = V2,
% V1 = V2, % (3)
group_by_variant(Pairs, V2-S2, Solutions, Pairs0).
group_by_variant(Pairs, _, [], Pairs).
@@ -1075,17 +1076,16 @@ abolish(Pred) :-
; throw(error(type_error(predicate_indicator, Pred), abolish/1))
).
'$iterate_db_refs'(Ref, Name/Arity) :-
'$lookup_db_ref'(Ref, Name, Arity).
'$iterate_db_refs'(Ref, Name/Arity) :-
'$get_next_db_ref'(Ref, NextRef),
'$iterate_db_refs'(NextRef, Name/Arity).
'$iterate_db_refs'(Name, Arity, Name/Arity). % :-
% '$lookup_db_ref'(Ref, Name, Arity).
'$iterate_db_refs'(RName, RArity, Name/Arity) :-
'$get_next_db_ref'(RName, RArity, RRName, RRArity),
'$iterate_db_refs'(RRName, RRArity, Name/Arity).
current_predicate(Pred) :-
( var(Pred) ->
'$get_next_db_ref'(Ref, _),
'$iterate_db_refs'(Ref, Pred)
'$get_next_db_ref'(RN, RA, _, _),
'$iterate_db_refs'(RN, RA, Pred)
; Pred \= _/_ ->
throw(error(type_error(predicate_indicator, Pred), current_predicate/1))
; Pred = Name/Arity,
@@ -1094,15 +1094,14 @@ current_predicate(Pred) :-
; integer(Arity), Arity < 0
) ->
throw(error(type_error(predicate_indicator, Pred), current_predicate/1))
; '$get_next_db_ref'(Ref, _),
'$iterate_db_refs'(Ref, Pred)
; '$get_next_db_ref'(RN, RA, _, _),
'$iterate_db_refs'(RN, RA, Pred)
).
'$iterate_op_db_refs'(Ref, Priority, Spec, Op) :-
'$lookup_op_db_ref'(Ref, Priority, Spec, Op).
'$iterate_op_db_refs'(Ref, Priority, Spec, Op) :-
'$get_next_op_db_ref'(Ref, NextRef),
'$iterate_op_db_refs'(NextRef, Priority, Spec, Op).
'$iterate_op_db_refs'(RPriority, RSpec, ROp, _, RPriority, RSpec, ROp).
'$iterate_op_db_refs'(RPriority, RSpec, ROp, OssifiedOpDir, Priority, Spec, Op) :-
'$get_next_op_db_ref'(RPriority, RSpec, ROp, OssifiedOpDir, RRPriority, RRSpec, RROp),
'$iterate_op_db_refs'(RRPriority, RRSpec, RROp, OssifiedOpDir, Priority, Spec, Op).
can_be_op_priority(Priority) :- var(Priority).
can_be_op_priority(Priority) :- op_priority(Priority).
@@ -1114,8 +1113,8 @@ current_op(Priority, Spec, Op) :-
( can_be_op_priority(Priority),
can_be_op_specifier(Spec),
error:can_be(atom, Op) ->
'$get_next_op_db_ref'(Ref, _),
'$iterate_op_db_refs'(Ref, Priority, Spec, Op)
'$get_next_op_db_ref'(RPriority, RSpec, ROp, OssifiedOpDir, _, _, Op),
'$iterate_op_db_refs'(RPriority, RSpec, ROp, OssifiedOpDir, Priority, Spec, Op)
).
list_of_op_atoms(Var) :-

9
src/lib/iso_ext.pl
View File

@@ -14,7 +14,7 @@
partial_string_tail/2,
setup_call_cleanup/3,
call_nth/2,
variant/2,
% variant/2,
copy_term_nat/2]).
:- use_module(library(error), [can_be/2,
@@ -22,6 +22,7 @@
instantiation_error/1,
type_error/3]).
:- use_module(library(lists), [maplist/3]).
:- meta_predicate(call_cleanup(0, 0)).
@@ -160,14 +161,12 @@ call_with_inference_limit(_, _, R, Bb, B) :-
'$erase_ball',
'$call_with_default_policy'(handle_ile(B, Ball, R)).
variant(X, Y) :- '$variant'(X, Y).
partial_string(String, L, L0) :-
( String == [] ->
L = L0
; catch(atom_chars(Atom, String),
error(E, _),
throw(error(E, partial_string/3))),
error(E, _),
throw(error(E, partial_string/3))),
'$create_partial_string'(Atom, L, L0)
).

2
src/lib/lists.pl
View File

@@ -3,7 +3,7 @@
maplist/3, maplist/4, maplist/5, maplist/6,
maplist/7, maplist/8, maplist/9, same_length/2, nth0/3,
sum_list/2, transpose/2, list_to_set/2, list_max/2,
list_min/2, permutation/2]).
list_min/2, permutation/2]).
/* Author: Mark Thom, Jan Wielemaker, and Richard O'Keefe
Copyright (c) 2018-2021, Mark Thom

14
src/lib/serialization/abnf.pl
View File

@@ -9,26 +9,26 @@
syntaxes. The DCGs are presented in the order they appear in the RFC.
While some DCGs below use `char_type/2`, the most common ones are defined
manually in order to take advantage of Prolog's first-argument indexing.
BSD 3-Clause License
Copyright (c) 2021, Aram Panasenco
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.
* Neither the name of the copyright holder nor the names of its
contributors may be used to endorse or promote products derived from
this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE

18
src/lib/serialization/json.pl
View File

@@ -1,29 +1,29 @@
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Written Apr 2021 by Aram Panasenco (panasenco@ucla.edu)
Part of Scryer Prolog.
`json_chars//1` can be used with [`phrase_from_file/2`](src/lib/pio.pl)
or [`phrase/2`](src/lib/dcgs.pl) to parse and generate [JSON](https://www.json.org/json-en.html).
BSD 3-Clause License
Copyright (c) 2021, Aram Panasenco
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.
* Neither the name of the copyright holder nor the names of its
contributors may be used to endorse or promote products derived from
this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
@@ -44,7 +44,7 @@
:- use_module(library(dif)).
:- use_module(library(lists)).
/* The DCGs are written to match the McKeeman form presented on the right side of https://www.json.org/json-en.html
/* The DCGs are written to match the McKeeman form presented on the right side of https://www.json.org/json-en.html
as closely as possible. Note that the names in the McKeeman form conflict with the pictures on the site. */
json_chars(Internal) --> json_element(Internal).

6
src/lib/uuid.pl
View File

@@ -4,9 +4,9 @@
This library provides reasoning about UUID (only version 4 right now).
There are three predicates:
* uuidv4/1, to generate a new UUIDv4
* uuidv4_string/1, to generate a new UUIDv4 in string hex representation
* uuidv4_string/1, to generate a new UUIDv4 in string hex representation
* uuid_string/2, to converte between UUID list of bytes and UUID hex representation
Examples:
?- uuidv4(X).
X = [42,147,248,242,117,196,79,2,129,159|...].
@@ -30,7 +30,7 @@
:- use_module(library(dcgs)).
:- use_module(library(lists)).
/*
/*
An UUID is made of 16 bytes, composed of 5 sections:
time_low - 4
time_mid - 2