812 Commits

Author SHA1 Message Date
Mark
126d7bba57 bump version number to v0.9.3
Some checks failed
CI / build-test (--no-default-features, ubuntu-22.04, true, nightly, wasm32-unknown-unknown) (push) Has been cancelled
CI / build-test (macos-11, true, stable, x86_64-apple-darwin) (push) Has been cancelled
CI / build-test (true, ubuntu-22.04, true, stable, x86_64-unknown-linux-gnu) (push) Has been cancelled
CI / build-test (ubuntu-20.04, true, stable, x86_64-unknown-linux-gnu) (push) Has been cancelled
CI / build-test (ubuntu-22.04, 1.70, x86_64-unknown-linux-gnu) (push) Has been cancelled
CI / build-test (ubuntu-22.04, beta, x86_64-unknown-linux-gnu) (push) Has been cancelled
CI / build-test (ubuntu-22.04, nightly, x86_64-unknown-linux-gnu) (push) Has been cancelled
CI / build-test (ubuntu-22.04, true, stable, i686-unknown-linux-gnu) (push) Has been cancelled
CI / build-test (windows-latest, true, stable, x86_64-pc-windows-msvc) (push) Has been cancelled
CI / logtalk-test (push) Has been cancelled
CI / release (push) Has been cancelled
Docker Publish / build (push) Has been cancelled
2023-11-02 17:01:54 -06:00
Mark Thom
575245c62f Merge pull request #1880 from coasys/library-use-case
Programatic use of Machine / Scryer as library
2023-11-02 16:50:01 -06:00
Nicolas Luck
59264c0aa5 Check for target_arch = “wasm32”
instead of target_os = “wasi”
2023-11-02 19:07:55 +01:00
Nicolas Luck
ee1bd9e006 Merge branch 'master' into library-use-case 2023-11-02 11:12:54 +01:00
Mark
dfd9e43405 correct (\+)/1 (#2141) 2023-10-31 23:58:59 -06:00
Mark
8f06ef965a remove non-conforming hyperbolic and log10 evaluable functors 2023-10-28 18:17:43 -06:00
Mark
ae7cf15c70 fix signed modulus bug (#2134) 2023-10-28 18:13:42 -06:00
Mark Thom
469d2bd104 Merge pull request #2140 from aarroyoc/rename-to-upper
Rename `to_upper` to `upper` and `to_lower` to `lower`
2023-10-28 14:48:10 -06:00
Adrián Arroyo Calle
682b2ada4c Rename to_upper to upper and to_lower to lower 2023-10-28 19:16:07 +02:00
Mark Thom
f4e5426e97 Merge pull request #2137 from infogulch/master
CI: compile wasm separately; default 22.04; matrix
2023-10-26 14:07:18 -06:00
infogulch
6bae789bd6 CI: compile wasm separately; default 22.04; matrix 2023-10-26 14:23:32 -05:00
Mark
ff19db0084 qualify dif/2 call in reinforce_goal (#2135) 2023-10-25 12:26:01 -06:00
Mark
f10d7c05f9 correct char_type/2 (#2132) 2023-10-24 15:35:37 -06:00
Mark
f80dff851b remove unnecessary macros inclusion in mock_wam.rs 2023-10-24 15:15:29 -06:00
Mark
63cbeb9a3c correct modulus bug (#2118, #2119) 2023-10-24 14:20:26 -06:00
Mark
773d3f81fd remove list remnants from stack iteration in printer when cyclic (#2131) 2023-10-24 14:10:11 -06:00
Mark
4ab3e23b1f fix cycle detection in lists by looking backward analogously to the same process for structures (#2130) 2023-10-24 12:23:05 -06:00
Mark
d588b18c39 correct LIS backward bug in cycle_detection.rs 2023-10-23 13:28:44 -06:00
Mark
97b899f4a3 add STOP_AT_CYCLES const parameter for CycleDetectingIter 2023-10-23 12:05:13 -06:00
Mark
6a913bc4cc use Deutsch-Schorr-Waite to implement acyclic_term/1 (#2128) 2023-10-21 21:47:29 -06:00
Mark
bf46c4b5c1 use topo_sort to correct acyclic_term (#2124, #2125) 2023-10-18 12:00:40 -06:00
Nicolas Luck
69a0725c30 Cleanup Cargo.toml 2023-10-17 22:09:34 +02:00
Nicolas Luck
0c9740fe52 Fix wasm warnings 2023-10-17 22:07:38 +02:00
Mark
43f0b6c28d fix cyclicity detection through variables (#2122, #2123) 2023-10-16 15:19:43 -06:00
Nicolas Luck
2776beb842 Use std::sync::RwLock instead of tokio::sync::RwLock (by @aarroyoc) 2023-10-16 14:59:06 +02:00
Nicolas Luck
d7fa6c0ade Fix signalling of success/failure (by @mthom) 2023-10-16 14:56:17 +02:00
Nicolas Luck
025412aac0 Revert "Remove unuse import"
This reverts commit bfa7d3cf41.
2023-10-16 14:55:38 +02:00
Nicolas Luck
bfa7d3cf41 Remove unuse import 2023-10-16 13:44:51 +02:00
Nicolas Luck
9990780b82 Merge branch 'master' into library-use-case 2023-10-16 13:43:26 +02:00
Mark
dff2e73842 more eagerly check for cyclicity of variables in cycle detecting stackless iterator (#2121) 2023-10-15 17:43:29 -06:00
Mark
e2000859b6 add backward looking cyclicity check for variables in cycle detecting stackless iterator (#2111, #2117) 2023-10-15 13:07:41 -06:00
Mark
3a6aee72a3 correct is_cyclic again for non-variable ref cells (#2116) 2023-10-15 01:28:42 -06:00
Mark
3fb2e451a2 improve cycle detection in detect_list_cycles (#2111) 2023-10-15 00:58:19 -06:00
Mark
7875b96956 simplify stackless iterator is_cyclic (#2111) 2023-10-14 23:56:46 -06:00
Mark
d96c9e00b7 correct more acyclic_term/1 issues (#2111, #2114), add acyclic_term tests 2023-10-14 18:38:10 -06:00
Mark
379c252b89 correct cyclic variable check in cycle detecting stackless iterator (#2111, #2113) 2023-10-14 14:03:47 -06:00
Mark
307cb56ef5 fix bugs & incompleteness of cycle-detecting stackless iterator (#2111) 2023-10-14 13:00:58 -06:00
notoria
62e6ca02f9 Reify (^)/2
Like (/)/2, (^)/2 can fail in cases such as 0 #==> X #= 2^(-1), where success is expected.
2023-10-14 12:11:24 -06:00
notoria
c6fcbe20e1 Trigger propagator for popcount/1 2023-10-14 12:11:24 -06:00
notoria
a1b71f0440 Trigger propagator for sign/1 2023-10-14 12:11:24 -06:00
notoria
dc08c26d9f Trigger propagator for (xor)/2 2023-10-14 12:11:24 -06:00
Mark
669023914a add bounds checks for stackless iterator (#2110) 2023-10-14 12:11:22 -06:00
Mark
e4a677ceea detect all cycles in roughly linear time and constant space (#2102) 2023-10-13 18:05:52 -06:00
Mark
8aadc99f1d fix bugs in marker algorithm iterator 2023-10-13 14:38:50 -06:00
Mark
1ea397a807 correct (mod)/2 (#2103, #2107) 2023-10-13 14:33:50 -06:00
Mark Thom
b348f54c33 Merge pull request #2105 from triska/morphing_propagators
ENHANCED: Omit unnecessary residual constraints in disentailed reified (//)/2
2023-10-12 19:10:54 -06:00
Markus Triska
721cf20cf7 shift morphing to the more general p/2 case 2023-10-12 23:32:04 +02:00
Markus Triska
6ed9a99832 ENHANCED: Omit unnecessary residual constraints in disentailed reified (//)/2
Example:

    ?- #\ 0#=(Y// -1)/0.
    %@    clpz:(Y in inf..sup).

This addresses #2104.
2023-10-12 23:32:04 +02:00
Mark
1163d14ea1 fix control construct bugs, iter indentation (#947) 2023-10-11 12:41:45 -06:00
Mark
b83631fb20 Merge branch 'master' of ssh://github.com/mthom/scryer-prolog 2023-10-11 10:11:50 -06:00
Mark
902b08e657 follow marked variables to end in eager_stackful_iter (#2100, #2101) 2023-10-10 20:45:08 -06:00
Mark
b5fdde08aa follow marked variables to end in eager_stackful_iter (#2100, #2101) 2023-10-10 16:03:12 -06:00
Mark Thom
4962c3df11 Merge pull request #2098 from triska/morphing_propagators
Queue morphed propagators to give them a chance for propagation
2023-10-10 14:57:00 -06:00
Markus Triska
8de3498e07 use round brackets around operators to form valid Prolog terms 2023-10-10 21:32:45 +02:00
Markus Triska
26fdf83a48 update comment to reflect the used propagators 2023-10-10 21:32:45 +02:00
Markus Triska
32af047925 remove definition and calls of do_queue/0, which has become a NOP 2023-10-10 21:32:45 +02:00
Markus Triska
282633c877 ENHANCED: Queue morphed propagators to give them a chance for propagation.
This addresses #2096:

    ?- B in -2..0, 0#<==>0#=0/(B*B),labeling([],[B]).
       B = 0.

    ?- A#<==>A#=A/A^2,A=0.
       A = 0.
2023-10-10 21:32:45 +02:00
Mark
77de570aa4 report pre-marked values from eager stackful iterator (#2097) 2023-10-10 12:56:27 -06:00
Mark Thom
c9df19ca30 Merge pull request #2094 from triska/unary_minus
ENHANCED: use (+)/2 to express unary minus
2023-10-09 15:06:09 -06:00
Markus Triska
7c1cd18a06 Z --> Y 2023-10-09 23:13:09 +02:00
Mark Thom
0ca2356be5 Merge pull request #2092 from triska/morphing_pexp
attach the propagator to Y
2023-10-09 15:05:59 -06:00
Markus Triska
8329d222cb ENHANCED: use (+)/2 to express unary minus
This makes answers a bit shorter and more readable.

Example:

    ?- X #= -Y.
       clpz:(X+Y#=0).

This addresses #2058.
2023-10-09 22:59:51 +02:00
Markus Triska
1c3df1cdd7 attach the propagator to Y 2023-10-09 21:55:39 +02:00
Mark Thom
b149805b9e Merge pull request #2091 from triska/morphing_pexp
ENHANCED: Omit projection of morphed (^)/2 in disentailed constraints.
2023-10-09 13:43:25 -06:00
Markus Triska
99348ec309 ENHANCED: Omit projection of morphed (^)/2 in disentailed constraints.
Example:

    ?- B #<==> (0^Y/0) #= Z.
       B = 0, clpz:(Y in 0..sup), clpz:(Z in inf..sup).
2023-10-09 21:33:04 +02:00
Mark Thom
c6976c0f92 Merge pull request #2090 from triska/morphing_propagators
FIXED: Queue triggered propagators to be processed after pexp/3 finishes
2023-10-09 13:20:44 -06:00
Markus Triska
cacc7f3193 FIXED: Queue triggered propagators to be processed after pexp/3 finishes
If reification constraints (such as reified equality) are triggered
here, then they may wish to disable this propagator and remove
attributes from auxiliary variables. If the pexp/3 propagation is
interrupted for that purpose, then the attributes will be
unintentionally reattached by the following fd_put/3 calls in this
propagator. We must ensure that this propagator completely finishes,
so we queue the triggered propagators for later processing.

geq/2 implements propagator activation outside the queue, and thus
should not be used in propagators in the way it was used here.

pexp/3 by itself may not seem particularly important. However, it can
arise by metamorphosis from Var*Var. Example:

    ?- A#<==> -1#=C*C, C in 0..1.
       A = 0, clpz:(C in 0..1).

This addresses #2089.
2023-10-09 20:42:28 +02:00
Mark
4b9cf0952e do not push stack variables to the heap in term_variables (#2087) 2023-10-09 11:38:17 -06:00
Mark Thom
6d37684e9c Merge pull request #2088 from triska/morphing_propagators
ENHANCED: Remove no longer needed morphed propagators.
2023-10-08 12:45:45 -06:00
Markus Triska
743412de33 ENHANCED: Remove no longer needed morphed propagators.
This addresses all remaining cases from #2083, excepting (//)/2:

    ?- #\ 1#=(X*X)/0.
       clpz:(X in inf..sup).

    ?- #\ 1#=(X+X)/0.
       clpz:(X in inf..sup).

Still remaining:

    ?- #\ 0#=(Y// -1)/0.
       clpz:(-1*Y#=_A).
2023-10-08 20:15:56 +02:00
Mark Thom
11c1ee4481 Merge pull request #2085 from triska/reification_same_queue
Use the same queue for variables in reified constraints
2023-10-08 12:01:26 -06:00
Markus Triska
f34703a279 remove no longer needed goal projection for pdiv 2023-10-08 12:07:17 +02:00
Markus Triska
5cce8ddd7d ENHANCED: avoid pending residual constraints in disentailed reified (div)/2
This addresses #2083:

    ?- #\0#=0//0 div 2.
       true.
2023-10-08 11:53:06 +02:00
Markus Triska
ff63eacf2c replace list//1 by seq//1 from library(dcgs) 2023-10-08 11:28:52 +02:00
Markus Triska
8121dce2a4 instead of prdiv, use ptimes directly 2023-10-08 09:46:41 +02:00
Markus Triska
4d910f6bfe FIXED: variables in reified propagators must share the same queue
Otherwise, propagation steps may be inadvertently omitted, if
propagators are scheduled in a different queue.

This addresses #2084.
2023-10-08 09:45:20 +02:00
Markus Triska
51c00fce57 adapt query to Scryer Prolog 2023-10-08 09:26:22 +02:00
Mark
1ab14ea519 mark both components of a PStrLoc (#2082) 2023-10-07 18:48:49 -06:00
Mark Thom
c5c7c1913a Merge pull request #2080 from triska/reified_slash
Corrections to reified (/)/2
2023-10-06 15:31:13 -06:00
Markus Triska
3fc969b38b reorder and realign entries to form a contiguous group starting with d(D) 2023-10-06 22:58:56 +02:00
Markus Triska
7ed38d6c6c FIXED: reification of (/)/2 for undefined subexpressions
This addresses #2078 and #2079.
2023-10-06 22:55:46 +02:00
Mark
fa68fa211c replace eager_stackful_iter's mark stack with a second unmark phase 2023-10-05 20:21:28 -06:00
Nicolas Luck
69cf2c36bc Deactivate tokio runtime respawning on interrupt 2023-10-05 12:11:28 +02:00
Nicolas Luck
640c637ca8 Merge branch 'master' into library-use-case
# Conflicts:
#	Cargo.lock
#	Cargo.toml
#	src/http.rs
#	src/machine/mock_wam.rs
#	src/machine/mod.rs
#	src/machine/system_calls.rs
2023-10-05 12:06:47 +02:00
Mark
0ad4427f83 use eager_stackful_preorder_iter in variable_set, add term_variables/1 tests 2023-10-04 15:12:25 -06:00
Mark
1bfdea7527 rewrite ground_test, add tests for ground/1 (#2075) 2023-10-04 14:17:03 -06:00
Mark
6c36d067d7 Revert "consider Str, PStrLoc in ElideLists of StackfulHeapIterator (#2075)"
This reverts commit 1e60eeef34.
2023-10-04 11:57:09 -06:00
Mark
1e60eeef34 consider Str, PStrLoc in ElideLists of StackfulHeapIterator (#2075) 2023-10-04 00:27:01 -06:00
Mark Thom
005570c90a Merge pull request #2076 from infogulch/master
Pin logtalk to version before scryer support was removed
2023-10-03 21:24:19 -06:00
infogulch
c070fbec62 Pin logtalk to version before scryer support was removed 2023-10-03 21:14:45 -05:00
Mark
f9d44c93fd check for free variables in locations removed from iterator stack in ground_test (#2075) 2023-10-03 15:31:01 -06:00
Nicolas Luck
fab5ca9440 Fix nested List parsing 2023-10-03 20:19:57 +02:00
Nicolas Luck
7b128a9f00 Handle stub_b = b as false 2023-10-03 20:12:11 +02:00
Mark
fd14869ddc correct cycle detection in ground/1 (#2073) 2023-10-03 12:07:36 -06:00
Mark Thom
07d7d3b13b Merge pull request #2074 from triska/expansion_simpler
Revert "FIXED: corrections to expansion_simpler/2"
2023-10-03 11:54:04 -06:00
Markus Triska
7c10683e46 Revert "FIXED: corrections to expansion_simpler/2"
This reverts commit f3b848537a.

The root cause of this problem is a mistake in ground/1. See #2073.
2023-10-03 19:16:04 +02:00
Mark Thom
3ffea2d987 Merge pull request #2072 from aarroyoc/fix-urldecode
Improved version of url_decode
2023-10-02 16:06:35 -06:00
Mark Thom
770665a7b8 Merge pull request #2070 from triska/expansion_simpler
FIXED: corrections to expansion_simpler/2
2023-10-02 16:06:10 -06:00
Adrián Arroyo Calle
93ff049e54 Improved version of url_decode 2023-10-02 23:49:09 +02:00
Markus Triska
f3b848537a FIXED: corrections to expansion_simpler/2
Example:

    ?- X = 0, Y = 0, Z #= X-1 + Y-1.
       X = 0, Y = 0, Z = -2.

This addresses #2064.

See ca5a5b4392 for a previous issue in
this logic.
2023-10-02 23:17:06 +02:00
Mark
27b971cbfa add registers to inlined instruction functors 2023-10-01 23:50:07 -06:00
Mark
a1ceeb697a consider an '$aux' a relation of the unexpanded goal's variables in compile_inline_or_expanded_goal (#2062) 2023-10-01 23:49:55 -06:00
Mark
4a8aa0acbd throw instantiation_error from error/2 if Error_term uninstantiated (#2060) 2023-09-30 22:35:46 -06:00
Mark
6fa00b5b55 get rid of inference_limit_exceeded(B) as an error term (#2023) 2023-09-30 22:35:46 -06:00
Mark Thom
c2218faf47 Merge pull request #2066 from bakaq/dif_tests
Add tests for #2056
2023-09-30 18:41:50 -06:00
bakaq
21c61b6e3a Add tests for #2056 2023-09-30 21:33:42 -03:00
Mark
b065e1cd53 correct depth calculation for lists that are their own car (#1876) 2023-09-30 17:15:20 -06:00
Mark
7d6ce119f5 substitute names for cyclic variables permitted by max_depth > 0 in check_for_seen using a loop (#2057) 2023-09-30 16:47:13 -06:00
Mark
62c23166fa implement ListElisionPolicy to restore previous printer behavior 2023-09-30 16:00:15 -06:00
Mark
25afc11168 correct skipping of not fully visited lists in stackful heap iterator (#2056, #2063, #2065) 2023-09-30 15:24:30 -06:00
Mark
9e713406d3 correct max_depth marking for lists 2023-09-30 11:44:20 -06:00
Mark
f33f641f11 further max_depth improvements 2023-09-29 12:07:12 -06:00
Mark
ca2ddfeed0 improve max_depth write option (#1876, #2053) 2023-09-29 01:00:14 -06:00
Mark
11cd42379b do not deref AttrVar binding in redo_attr_var_binding (#2059) 2023-09-28 15:25:57 -06:00
Mark
40d3345cd5 revert throwing domain errors for unexpected forms of read-options (#2015) 2023-09-27 18:58:45 -06:00
Mark
035e214ef5 check for ChildCloseList in print_struct on [] (#2039) 2023-09-27 18:16:23 -06:00
Mark
f630a8cc1a fix add_predicate_declaration bug not correctly identifying lists of predicate indicators (#2049, #2050, #2051, #2052) 2023-09-27 17:55:15 -06:00
Mark
0bfb08e464 remove debug symbols from release builds (#2054) 2023-09-27 13:53:33 -06:00
Mark Thom
5f6ae3857b Merge pull request #1998 from aarroyoc/warp-http-server
Replace Hyper with Warp for HTTP server
2023-09-27 13:35:46 -06:00
Mark
750544dd2a fix max_depth settings for partial strings on lists (#1876) 2023-09-27 13:34:24 -06:00
Adrián Arroyo Calle
660860bccf Replace Hyper with Warp for HTTP server
- Use Warp
- Optimize clones
- HTTPS server
- Content-Length limit
- HTTP Basic Auth
- Stop server with Ctrl-C
2023-09-27 18:50:19 +02:00
Mark Thom
841aaa78b4 Merge pull request #2048 from infogulch/master
Build windows with msvc #1998; add ubuntu 22.04 target #2047
2023-09-27 10:43:54 -06:00
infogulch
93f46a4142 Tidy ci.yaml 2023-09-27 02:58:48 -05:00
infogulch
a86db1bde8 Build windows with msvc 2023-09-27 02:57:02 -05:00
infogulch
4163437d5a Add ubuntu 22.04 2023-09-27 00:31:08 -05:00
Mark
a6535c28ea remove module_resolution_error (#2035) 2023-09-26 14:06:21 -06:00
Mark
2efe95f2fb filter our builtins from current_predicate/1 (#153) 2023-09-26 13:46:21 -06:00
Mark
56992570d8 check for predicate_indicator list and sequence types in add_predicate_declaration (#1586) 2023-09-26 12:54:16 -06:00
Mark
39934208c3 throw instantiation_error when appropriate from parse_write_options_ (5.5.12 of the standard, #1965) 2023-09-26 12:08:51 -06:00
Mark
193bb313fd correct OutOfFiles resource error (#1375) 2023-09-26 11:22:56 -06:00
Mark
e8334f9b67 add predicate indicator sequences to loader:add_predicate_declaration (#1586) 2023-09-26 11:21:47 -06:00
Mark
280ff8b5d0 throw an error instead of allowing builtin modules to be overwritten (#2042) 2023-09-25 19:21:34 -06:00
Mark
172bb9e96a Merge branch 'master' of ssh://github.com/mthom/scryer-prolog 2023-09-25 16:09:20 -06:00
Mark
c04f1dea48 fix off-by-1 bug in '$skip_max_list'/4 (#2037) 2023-09-25 16:09:04 -06:00
Mark Thom
9114c982e0 Merge pull request #2032 from bakaq/phrase_from_stream
Add phrase_from_stream/2 to library(pio)
2023-09-25 12:04:33 -06:00
bakaq
f644a76281 Remove reposition option from phrase_from_file/2 2023-09-25 02:18:05 -03:00
bakaq
63bb993c02 Inline string_get_n_chars_/3 2023-09-24 19:29:51 -03:00
bakaq
c50291cec8 Better string_get_n_chars_/3 2023-09-24 19:21:03 -03:00
bakaq
2fe79b5fc3 Fixed bug with '$skip_max_list'/4 2023-09-24 15:08:24 -03:00
bakaq
b4fab5a806 Use '$skip_max_list'/4 in string_get_n_chars/4 2023-09-24 14:32:44 -03:00
bakaq
35d0042be1 Add phrase_from_stream/2 to library(pio) 2023-09-24 14:32:44 -03:00
Mark Thom
75dcc3f276 Merge pull request #2040 from rujialiu/allow-cr
Solves CRLF/CR issue by considering'\r' a `layout_char` #553 #2028
2023-09-24 11:11:15 -06:00
Rujia Liu
9c43974747 Solves CRLF/CR issue by considering'\r' a layout_char #553 #2028 2023-09-24 19:10:40 +08:00
Mark Thom
4be5fc6d43 Merge pull request #2038 from infogulch/patch-1
Allow all matrix ci jobs to run to completion even if one fails
2023-09-24 00:44:33 -06:00
Joe Taber
f03336b3a2 Allow all jobs to run to completion even if one fails
See: https://docs.github.com/en/actions/using-workflows/workflow-syntax-for-github-actions#jobsjob_idstrategyfail-fast
2023-09-23 21:43:51 -05:00
Mark
a5db117ef6 fix off-by-1 bug in ''/4 (#2037) 2023-09-23 18:32:32 -06:00
Mark
142e0c2c3a don't parse bracketed non-operators as functor terms (#2033) 2023-09-23 14:26:28 -06:00
Mark
1c8cd85f6c record compaction depth after reduce_op if '|' an operator (#1905) 2023-09-23 00:19:54 -06:00
Mark
c547f67c54 add (now failing) test 317 to iso_conformity_tests.pl 2023-09-21 16:49:45 -06:00
Mark
c26e9436b4 generalize multifile/dynamic/discontiguous declarations over lists of predicate indicators (#1586) 2023-09-21 16:22:41 -06:00
Mark
b3239abea1 throw resource error if OpenOptions raises an error of uncategorized kind (#1375) 2023-09-21 14:36:53 -06:00
Mark Thom
81edd4592f Merge pull request #2027 from bakaq/dif
Improvements to dif/2
2023-09-21 11:32:38 -06:00
Mark Thom
7484433e2b Merge pull request #2026 from infogulch/master
Simplify fn maybe
2023-09-21 11:31:35 -06:00
bakaq
cb79e83510 Avoid dif/1 attribute with empty list
Closes #1956
2023-09-21 14:00:37 -03:00
bakaq
cac52c0537 Run dif tests on cargo test 2023-09-21 12:14:27 -03:00
bakaq
f5c23fbb16 Tests for dif/2 2023-09-20 20:56:25 -03:00
bakaq
a64a765f32 Improved dif/2 2023-09-20 20:56:04 -03:00
infogulch
eecfeb2d03 Simplify maybe
Fix whitespace
2023-09-20 18:23:07 -05:00
Mark Thom
54a0313d72 Merge pull request #2025 from aarroyoc/random-seed
Use a SeedableRng to generate random numbers
2023-09-20 15:03:21 -06:00
Adrián Arroyo Calle
7cf6e77f4d Use a SeedableRng to generate random numbers 2023-09-20 22:07:46 +02:00
Nicolas Luck
4968fa0024 Remove debugging println! 2023-09-18 19:31:56 +02:00
Nicolas Luck
5e55625733 Remove some debug println!s 2023-09-18 19:12:50 +02:00
Nicolas Luck
65f64e428e Construct and return exception string 2023-09-18 13:25:27 +02:00
Nicolas Luck
d2f5291412 mthom's changes fixing the panic 2023-09-18 13:01:27 +02:00
Mark
9dc1c339ef remove unnecessary Result return type from read_term_from_heap 2023-09-15 14:10:42 -06:00
Nicolas Luck
c86304b18e Remove lib_toplevel.pl 2023-09-15 11:01:16 +02:00
Nicolas Luck
7c83a1fb8e Cleanup code that's not needed anymore 2023-09-15 10:48:41 +02:00
Nicolas Luck
f02728aab3 Construct QueryResult from printer output 2023-09-15 10:44:59 +02:00
Nicolas Luck
48283c4dbc mthom's changes to run_query with backtracking 2023-09-15 10:04:11 +02:00
Nicolas Luck
6bdd7f3a3f mthom's revised run_query with manually created printer and some cleanup 2023-09-14 22:00:50 +02:00
Mark Thom
6e0dd371a0 Merge pull request #2018 from triska/libffi
use version from crates.io
2023-09-13 15:05:31 -06:00
Markus Triska
5b1df8c4b3 use version from crates.io 2023-09-13 20:45:38 +02:00
Nicolas Luck
5fa68e253c lib_machine tests should not be tokio/async 2023-09-13 19:51:57 +02:00
Mark Thom
3e14ef634f Merge pull request #2017 from cmpute/master
Upgrade dashu and make the related code more idomatic.
2023-09-13 10:41:34 -06:00
Jacob
adb5fcf708 Upgrade dashu and some changes 2023-09-13 12:29:12 -04:00
Nicolas Luck
136463c92e Merge branch 'master' into library-use-case
# Conflicts:
#	Cargo.toml
#	src/atom_table.rs
#	src/bin/scryer-prolog.rs
#	src/http.rs
#	src/machine/mock_wam.rs
#	src/machine/mod.rs
#	src/machine/system_calls.rs
2023-09-13 18:13:14 +02:00
Nicolas Luck
ef56193c44 Use write_term_to_heap as suggest, clean up, and include error in comment 2023-09-13 17:17:02 +02:00
Mark
4077040d03 update syn crates 2023-09-12 14:52:42 -06:00
Mark
de440a8c92 get rid of OssifiedOpDir, DBRef, simplify current_op/3 2023-09-11 15:36:15 -06:00
Mark Thom
c75f74f681 Merge pull request #1993 from coasys/dashu-fixes
Dashu fixes
2023-09-11 11:33:16 -06:00
Mark Thom
46c78ad338 Merge pull request #2013 from gruhn/fix-docker-debian-bullseye
fix Docker image
2023-09-11 11:23:10 -06:00
Niklas Gruhn
2b7a8875c0 fix Docker image
The Docker image is broken with the error message:

    scryer-prolog: error while loading shared libraries:
    libssl.so.1.1: cannot open shared object file: No such
    file or directory

We use the base base image `debian:stable-slim` and in the
background a new Debian version was marked stable (bookworm),
which has libssl3 instead of libssl1.1 installed.

I downgraded the base image to the previous stable version
(bullseye), which seems to fix the issue.
2023-09-11 01:46:59 +02:00
Mark Thom
2ee131c52c Merge pull request #2010 from aarroyoc/update-website-0.9.2
Update INDEX.dj
2023-09-10 17:45:45 -06:00
Adrián Arroyo Calle
f3901cd8b8 Update website to mention 0.9.2 and playground 2023-09-10 23:12:10 +02:00
Fayeed Pawaskar
7f0536b51d Merge branch 'master' into dashu-fixes 2023-09-10 21:51:02 +05:30
Fayeed Pawaskar
af76659830 Removed value method and use deref to get type 2023-09-10 21:40:22 +05:30
Mark Thom
fb658c4918 Merge pull request #2008 from triska/clpb_improvements
Various CLP(B) improvements
2023-09-09 00:40:30 -06:00
Markus Triska
85cc4a80d0 remove code that is not needed in Scryer Prolog 2023-09-09 07:46:01 +02:00
Markus Triska
6fe85c5779 remove more attributes so that they do not appear in residual goals 2023-09-09 07:46:01 +02:00
Markus Triska
b38a56e7d3 move compatibility predicates and meta_predicate/1 declarations so that they are correctly taken into account 2023-09-09 07:46:01 +02:00
Mark Thom
cbf18e5c3a Merge pull request #2006 from infogulch/wasm-ci
Add wasm build steps
2023-09-08 23:34:59 -06:00
Mark Thom
96bd0d267c Merge pull request #2007 from triska/rust_1_70
update required Rust version
2023-09-08 23:34:36 -06:00
Markus Triska
ec67752db4 shorter partition/5, relying on first instantiated argument indexing 2023-09-09 07:32:06 +02:00
Markus Triska
ad4c17fbb6 add meta_predicate/1 declaration for include/3 and exclude/3 2023-09-09 07:32:06 +02:00
Markus Triska
672979c515 shorter include/3 and exclude/3, relying on improved indexing 2023-09-09 07:32:06 +02:00
Markus Triska
efcc2b81cd add licensing information, addressing part of #1798 2023-09-09 07:32:06 +02:00
Markus Triska
640f29fe0f update required Rust version 2023-09-09 07:30:23 +02:00
Joe Taber
13a0085408 Add wasm build steps 2023-09-08 22:47:06 -05:00
Mark Thom
74440d503e Merge pull request #2004 from triska/generalize_description
this holds for all architectures (also 32-bit systems)
2023-09-08 16:11:06 -06:00
Mark Thom
f4769de5c4 Merge pull request #2003 from triska/clpz_comment
update comment
2023-09-08 15:22:49 -06:00
Markus Triska
b843b76b7a this holds for all architectures (also 32-bit systems) 2023-09-08 23:22:36 +02:00
Markus Triska
182afe3b7d update comment 2023-09-08 22:34:24 +02:00
Mark Thom
920e0c6b56 Merge pull request #1986 from rujialiu/wasm32-support
Basic WebAssembly support with minimal Javascript API #615
2023-09-08 11:15:51 -06:00
Rujia Liu
b6ce6b7cdb Basic WebAssembly support with minimal Javascript API #615. Currently 6/12 crypto functions supported. Tested in browser with all default features disabled. 2023-09-08 17:27:22 +08:00
Mark
a0b5a24853 check atom == ',' in ambiguity_check mirroring logic in print_op_addendum (#2000) 2023-09-05 14:56:26 -06:00
Mark
fa11d6bdd4 remove error printing redundancy and inconsistent state resulting from file_load_cleanup (#1995) 2023-09-05 13:53:57 -06:00
Mark Thom
a9aef2bc84 Merge pull request #1980 from Skgland/atomtable
make AtomTable consurrency safe
2023-09-05 12:32:20 -06:00
Mark Thom
bf2b73706a Merge pull request #1997 from triska/countall
Corrections to countall/2
2023-09-05 12:04:52 -06:00
Mark
83ebce86b6 call_with_inference_limit/3 should fail if inference limit is exceeded and R term is not inference_limit_exceeded (#1977) 2023-09-05 11:51:06 -06:00
Markus Triska
1967518fa2 FIXED: documentation of countall/2 (#1976) 2023-09-05 19:42:55 +02:00
Bennet Bleßmann
5928d64d7a make F64Table concurency safe 2023-09-05 19:39:59 +02:00
Bennet Bleßmann
c7ec5a13a5 remove locks from AtomTable
there are technically still two locks
- the Mutex to serialize consurrent updates to the AtomTable
- the RwLock as part of GLOBAL_ATOM_TABLE

the former is the age lock of RESIZE ATOM TABLE in <https://arxiv.org/pdf/1608.00989.pdf>, though we use it for the whole update as we don't match the whole structure and can't reserve an atom slot as is, so we need to also lock concurrent updates without resizing

the later should be uncontendet as we only write AtomTable::new iff the current value is a dangling Weak
2023-09-05 19:39:59 +02:00
Bennet Bleßmann
01aeb7515d [WIP] move towards lockless AtomTable 2023-09-05 19:39:46 +02:00
Markus Triska
d54c3369b3 FIXED: countall/2 for zero solutions (#1996)
Example:

    ?- countall(false, 0).
       true.
2023-09-05 19:39:05 +02:00
Skgland
d24e6100a7 fix rust_beta_channel feature 2023-09-05 19:12:23 +02:00
Skgland
cd0e45b70e fix accidentally left in println!() 2023-09-05 19:12:23 +02:00
Skgland
0f0018abe4 raise msrv for OnceLock support 2023-09-05 19:12:23 +02:00
Skgland
a95c5e26e6 add comment why blocking_write is not used 2023-09-05 19:12:23 +02:00
Skgland
70b6cc8e55 fix deadlock in load_library_as_stream 2023-09-05 19:12:22 +02:00
Bennet Bleßmann
13cbff7eab [WIP] fix deadlock in AtomTable::build_with 2023-09-05 19:12:22 +02:00
Skgland
86166dbf25 [WIP] make AtomTable concurrentcy ready 2023-09-05 19:12:22 +02:00
Skgland
b2130c2a48 run cargo fmt 2023-09-05 19:12:17 +02:00
Mark
5585e83fd6 correct inference counting over index backtracking, built-ins (#1977, #1987) 2023-09-04 17:15:16 -06:00
Fayeed Pawaskar
7b921fc767 Implemented num_order methods on Integer & Rational numbers 2023-09-04 14:12:47 +05:30
Fayeed Pawaskar
cfd67c8337 Added new unify methods 2023-09-04 14:12:11 +05:30
Fayeed Pawaskar
dc498d4de8 Fixed warning 2023-09-04 14:11:54 +05:30
Fayeed Pawaskar
2c67106f26 Added value method to get the generic type from TypedArenaPtr 2023-09-04 14:11:30 +05:30
Fayeed Pawaskar
b105c33b79 Added latest dashu from github 2023-09-04 14:09:45 +05:30
Mark Thom
2ccc238119 Merge pull request #1991 from triska/discoverable_flags
FIXED: make occurs_check and answer_write_options flags discoverable
2023-09-03 18:39:24 -06:00
Mark Thom
e693b7d33b Merge pull request #1990 from triska/clpb_max
remove clpb_max/1 attribute for residual goal projection
2023-09-03 18:39:12 -06:00
Markus Triska
aca0de06cd FIXED: make occurs_check and answer_write_options flags discoverable
Quoting from 7.11 Flags:

   NOTE - A built-in predicate current_prolog_flag(Flag, Value)
   (8.17.2) enables a program to discover all the flags supported
   by a processor and their current values.
2023-09-04 00:56:09 +02:00
Markus Triska
85f4bdbe0b update answer 2023-09-03 22:01:38 +02:00
Markus Triska
1257ba165f untabify 2023-09-03 21:57:51 +02:00
Markus Triska
1c33d2a2ed remove clpb_max/1 attribute for residual goal projection
Example:

    ?- sat(A+B), weighted_maximum([1,1], [A,B], Max).
       A = 1, B = 1, Max = 2.
2023-09-03 21:56:15 +02:00
Mark Thom
99bd3d3b1a Merge pull request #1988 from triska/answer_write_options
ADDED: New Prolog flag, answer_write_options.
2023-09-03 11:36:40 -06:00
Mark Thom
d8aed0ac4f Merge pull request #1989 from triska/mention_binaries
mention precompiled binaries
2023-09-03 11:36:07 -06:00
Markus Triska
5ebd4bb2a4 mention precompiled binaries 2023-09-03 14:12:46 +02:00
Markus Triska
c934e06171 ADDED: New Prolog flag, answer_write_options.
This lets us specify additional write options used by the top level
for writing answers.
2023-09-03 10:49:07 +02:00
Nicolas Luck
8a0685a3e9 Debug print value of register 6 which leads to failing heap dereference 2023-08-30 20:01:56 +02:00
Nicolas Luck
2b018be392 Add back needed dep. hyper-util and upgrade hyper to rc4 2023-08-30 20:00:56 +02:00
Nicolas Luck
4d19c437e0 Merge branch 'master' into library-use-case
# Conflicts:
#	Cargo.toml
#	src/machine/mock_wam.rs
#	src/machine/mod.rs
2023-08-30 18:12:26 +02:00
Nicolas Luck
44c274b9e9 WIP: Pure Rust impl. of run_query 2023-08-30 17:35:36 +02:00
Mark
66f6399b8a refine is/2 compilation so errors are thrown when expected without needlessly allocating (#1974, #1984) 2023-08-29 16:42:23 -06:00
Mark
53a1be78cc don't compile is instruction if bound to anonymous variable (#1974) 2023-08-29 15:50:04 -06:00
Mark
78b35dc57d update Cargo.toml version numbers and bump version number
Some checks failed
CI / build-test (macos-11, stable, bash, x86_64-apple-darwin) (push) Has been cancelled
CI / build-test (true, ubuntu-20.04, stable, bash, x86_64-unknown-linux-gnu) (push) Has been cancelled
CI / build-test (ubuntu-20.04, 1.65, bash, x86_64-unknown-linux-gnu) (push) Has been cancelled
CI / build-test (ubuntu-20.04, beta, bash, x86_64-unknown-linux-gnu) (push) Has been cancelled
CI / build-test (ubuntu-20.04, nightly, bash, x86_64-unknown-linux-gnu) (push) Has been cancelled
CI / build-test (ubuntu-20.04, stable, bash, i686-unknown-linux-gnu) (push) Has been cancelled
CI / build-test (windows-latest, stable, msys2 {0}, x86_64-pc-windows-gnu) (push) Has been cancelled
CI / logtalk-test (push) Has been cancelled
CI / release (push) Has been cancelled
Docker Publish / build (push) Has been cancelled
2023-08-28 13:23:56 -06:00
Mark Thom
c65d1204af Merge pull request #1978 from aarroyoc/ci-32-bits
32 bit CI for Linux
2023-08-27 12:49:20 -06:00
Mark Thom
3bfed50d81 Merge pull request #1979 from triska/normalize_space
ENHANCED: rudimentary implementation of normalize_space
2023-08-27 12:48:48 -06:00
Adrián Arroyo Calle
4523bb5b81 32 bit CI for Linux 2023-08-27 19:25:54 +02:00
Markus Triska
75aec69de1 replace adjacent whitespace characters with a single SPACE character 2023-08-27 13:01:13 +02:00
Markus Triska
9b96735615 ENHANCED: rudimentary implementation of normalize_space
This removes leading and trailing whitespace from the text. Whitespace
within the string is not yet considered.
2023-08-27 09:56:30 +02:00
Mark Thom
f74d74fe6e Merge pull request #1972 from rujialiu/32-bit-support
32-bit system support #615 #1509 (WIP)
2023-08-25 10:51:15 -06:00
Nicolas Luck
77394ba914 Remove debug println!s 2023-08-24 19:15:41 +02:00
Nicolas Luck
d13173942d Cargo feature "multi_thread" for thread-local ATOM_TABLE_BUF_BASE 2023-08-24 19:13:11 +02:00
Nicolas Luck
afbadd9ea2 Revert "Enable multiple Machines per process by having ATOM_TABLE_BUF_BASE always be thread_local, not only in cfg(test) mode."
This reverts commit bfb3164a0d.
2023-08-24 19:13:11 +02:00
Nicolas Luck
c25888288a Fix parsing of floats 2023-08-24 18:10:47 +02:00
Rujia Liu
4fd059be5f 32-bit system support, addressing all (at most) 4GB addresses of RAM. 2023-08-24 20:05:40 +08:00
Nicolas Luck
bfb3164a0d Enable multiple Machines per process by having ATOM_TABLE_BUF_BASE always be thread_local, not only in cfg(test) mode. 2023-08-23 14:36:07 +02:00
Mark Thom
81712f4c82 Merge pull request #1973 from triska/clpz
CLP(ℤ) improvements, notably related to queue handling
2023-08-22 15:04:33 -06:00
Nicolas Luck
7e97f16f41 Fix list result parsing 2023-08-22 22:46:00 +02:00
Markus Triska
98086de77e attach more propagators before starting propagation
This prevents repeated triggering of already attached propagators
while new propagators are being attached to involved variables.
2023-08-22 21:52:55 +02:00
Markus Triska
24456e9703 remove optional (+)/1 prefix in get_atts/2 and put_atts/2 calls
The (+)/1 prefix in get_atts/2 at line 4219 by itself already causes a
greater than 15% slowdown for the benchmark shown in #1730:

    ?- N #= 2^14,
       time(((between(1, N, _),
              X #\= Y,
              false)
            ; true)).

The performance impact is not a good reason to remove the optional
(+)/1 prefix! Performance issues should be addressed at the root, in
this case get_atts/2 (#1962). We should never manually work around
performance issues in built-in predicates.

In contrast, readability is a good argument, and I find the calls
slightly easier to read without the optional (+)/1 prefix.

The prefix is now consistently omitted when possible.
2023-08-22 21:52:55 +02:00
Markus Triska
7f024f3b8d use pneq/2 2023-08-22 21:52:55 +02:00
Markus Triska
67c1b171c7 enforce same queue in more constraints 2023-08-22 21:52:55 +02:00
Markus Triska
04fbb0c1ce append the entire queues instead of inserting each element individually 2023-08-22 21:52:55 +02:00
Markus Triska
327423ab84 adapt query to Scryer Prolog 2023-08-21 21:19:29 +02:00
Markus Triska
20cfffdff5 update answers 2023-08-21 21:19:29 +02:00
Markus Triska
d8e126044f use can_be/2 2023-08-21 21:19:29 +02:00
Mark Thom
61f975ea18 Merge pull request #1967 from rujialiu/optional-features
Allow users to disable optional features
2023-08-21 11:42:03 -06:00
Rujia Liu
25d4950216 Allow users to disable optional features. Needed for wasm32 support (see #615). 2023-08-21 10:01:24 +08:00
Mark Thom
5aa1521819 Merge pull request #1968 from rujialiu/atom-64bit
Make Atom 64-bit regardless of architecture
2023-08-20 11:50:58 -06:00
Mark Thom
dd030fa18b Merge pull request #1970 from triska/crrl
switch to using crrl for scalar multiplication on Curve25519
2023-08-20 11:24:37 -06:00
Markus Triska
013df58fea ENHANCED: more extensive type checking in curve25519_scalar_mult/3 2023-08-20 14:43:14 +02:00
Markus Triska
745ddc2c87 switch to using crrl for scalar multiplication on Curve25519
This is to facilitate WASM compilation as currently worked on
by @rujialiu in #615. Many thanks, and many thanks to @pornin
for crrl which makes this possible!
2023-08-20 14:43:14 +02:00
Rujia Liu
f6d3b2f896 Make Atom 64-bit regardless of architecture 2023-08-20 19:43:13 +08:00
Mark Thom
7da321ab4f Merge pull request #1964 from triska/master
use newly available double_quotes/1 write option in portray_clause_//1
2023-08-17 15:18:25 -06:00
Markus Triska
92fdc7e380 use newly available double_quotes/1 write option in portray_clause_//1 2023-08-17 23:05:21 +02:00
Mark Thom
2e811de0f5 Merge pull request #1963 from triska/master
ENHANCED: domain error in zcompare/3 (#1723)
2023-08-14 12:18:45 -06:00
Markus Triska
f02cd0ad3c ENHANCED: domain error in zcompare/3 (#1723) 2023-08-14 17:54:18 +02:00
Mark Thom
a36df33a67 Merge pull request #1961 from triska/succ
ADDED: succ/2, part of the Prologue for Prolog
2023-08-12 14:35:21 -06:00
Markus Triska
4a6bf5fd5f reorder tests, per https://github.com/mthom/scryer-prolog/pull/1961#pullrequestreview-1574380588 2023-08-11 23:41:54 +02:00
Markus Triska
26c0b4fc75 ADDED: succ/2, part of the Prologue for Prolog
Specification:

   https://www.complang.tuwien.ac.at/ulrich/iso-prolog/prologue#succ
2023-08-11 22:46:46 +02:00
Fayeed Pawaskar
ce1c8aac4c Fixed libffi dep 2023-08-08 16:22:08 +05:30
Fayeed Pawaskar
72ceceb7ae Updated hyper to 1.0.0-rc.4 2023-08-08 16:20:49 +05:30
Nicolas Luck
cf63b588bc Ignore stress test because it fails on windows 2023-08-07 18:41:08 +02:00
Nicolas Luck
4e8f7f0a1b Remove unused toplevel predicate 2023-08-07 18:38:34 +02:00
Nicolas Luck
579816a04f Use new double_quotes write-option 2023-08-07 18:29:05 +02:00
Nicolas Luck
cc04872933 Merge branch 'master' into library-use-case 2023-08-07 16:42:48 +02:00
Mark
fad363e64a shed CodeIndex for control predicates in disjuncts.rs (#1791) 2023-08-06 01:26:01 -06:00
Mark
094cf2ac5d retract discontiguous non-multifile predicates between consultations (#1202, #1058, #1585) 2023-08-05 17:42:33 -06:00
Mark Thom
cc82727d20 Merge pull request #1950 from triska/chars_si
ENHANCED: more efficient chars_si/1, using specialized predicates of Scryer
2023-08-04 15:25:42 -06:00
Markus Triska
924750f826 ENHANCED: more efficient chars_si/1, using specialized predicates of Scryer
Source:

    https://github.com/mthom/scryer-prolog/issues/1947#issuecomment-1665113488
2023-08-04 21:18:37 +02:00
Mark Thom
ffbf630b5c Merge pull request #1948 from triska/chars_si
add character_si/1 and use it to correct chars_si/1
2023-08-03 18:34:19 -06:00
Markus Triska
8073a4ba87 add character_si/1 and use it to correct chars_si/1
This addresses #1947.
2023-08-03 22:27:13 +02:00
Nicolas Luck
48a4835819 Merge branch 'master' into library-use-case
# Conflicts:
#	Cargo.lock
#	Cargo.toml
#	src/bin/scryer-prolog.rs
#	src/loader.pl
#	src/machine/mock_wam.rs
#	src/machine/mod.rs
#	src/machine/system_calls.rs
2023-08-03 20:16:32 +02:00
Nicolas Luck
3cf3c0ea99 Integration stress test showing Machine blocking on query 2023-08-03 19:51:12 +02:00
Nicolas Luck
ac61055d43 Remove some unused code from lib_toplevel.pl 2023-08-03 17:41:20 +02:00
Joshua Parkin
65eb93793c dont spawn a runtime in machine; inherit from outside with runtime::handle::Current 2023-08-03 16:22:03 +01:00
Mark
ec450fc567 allocate negator results in arena (#1898) 2023-08-02 19:50:36 -06:00
Mark Thom
2c05ebbded Merge pull request #1943 from triska/dead_skeleton
FIXED: do not attach constraint if the propagator is already entailed and killed
2023-08-02 16:32:27 -06:00
Markus Triska
0ddda0a864 FIXED: do not attach constraint if the propagator is already entailed and killed
Example:

    ?- A#=A//A#==>B,A-B=1-1.
       A = 1, B = 1.

This addresses #1941.
2023-08-03 00:26:40 +02:00
Nicolas Luck
3ff02da314 Deactivate some debugging outputs 2023-08-02 16:25:53 +02:00
Nicolas Luck
df048a4f42 Switch back to run_input_once and use duplicated write_eqs/2 without any input handling 2023-08-02 14:52:49 +02:00
Nicolas Luck
21c36880f1 Fix build 2023-08-02 14:51:41 +02:00
Mark Thom
02328d818c Merge pull request #1938 from triska/remove_auxiliary_constraints
ENHANCED: forget auxiliary constraints set up by the propagator for multiplication
2023-07-31 14:52:34 -06:00
Mark Thom
0f55ba7218 Merge pull request #1939 from triska/oncology_trial_design
better wording, applying the feedback of @dcnorris. Thank you a lot!
2023-07-31 14:52:21 -06:00
Markus Triska
1c089a2bbb better wording, applying the feedback from @dcnorris. Thank you a lot! 2023-07-31 22:07:13 +02:00
Markus Triska
54a887cdc3 ENHANCED: forget auxiliary constraints set up by the propagator for multiplication
This addresses the issue raised in https://github.com/mthom/scryer-prolog/discussions/1937.
2023-07-31 21:57:25 +02:00
Mark Thom
ca28c76e52 Merge pull request #1929 from Skgland/master
detect and prevent concurrent AtomTable use
2023-07-29 10:52:36 -06:00
Bennet Bleßmann
a70157003b fix spelling 2023-07-29 13:11:00 +02:00
Bennet Bleßmann
6aa3c7d5d6 handle atom table resize
* bumping serial_test dev-dependency due to broken should_panic handling in old version
2023-07-29 11:22:25 +02:00
Bennet Bleßmann
4ef8c5c47d detect and prevent² concurrent AtomTable use
²in the case of `#[cfg(not(test))]` there is still a toctou race as I am not sufficently familiar with Atomics
2023-07-27 23:37:03 +02:00
Mark Thom
31d17f135a Merge pull request #1927 from triska/ascii_punctuation
FIXED: correct handling of ascii_punctuation in char_type/2 (#1926)
2023-07-27 14:51:01 -06:00
Markus Triska
03f7b01109 FIXED: correct handling of ascii_punctuation in char_type/2 (#1926) 2023-07-27 20:22:05 +02:00
Nicolas Luck
c2658dc6da Try triska's toplevel and add some debugging println!s. 2023-07-27 14:46:00 +02:00
Nicolas Luck
30dac8ea41 HashSet -> BTreeSet: Make parsing or results and thus tests deterministic. Add comments. 2023-07-27 12:06:03 +02:00
Nicolas Luck
0d28404aad Add special case when parsing 2023-07-27 11:50:38 +02:00
Nicolas Luck
2f99bb025c Add consult that works with streams / strings in library use-case 2023-07-27 11:41:52 +02:00
Mark
bff48e7c7f simplify and correct prefix-bracket spacing in heap_print.rs (#1914, #1918) 2023-07-26 09:32:54 -06:00
Mark
3b67ffa814 overwrite code indices of dynamic_undefined predicates (dynamic, multifile, discontiguous) on export 2023-07-25 13:48:34 -06:00
Mark Thom
49b4e4cbcb Merge pull request #1907 from coasys/dashu
Replace rug with dashu
2023-07-25 11:35:10 -06:00
Mark
287c308bc3 track the parent operator of the current operator in heap_print to emit space if necessary (#1906) 2023-07-24 20:05:28 -06:00
Mark
af44d91568 Merge branch 'dashu' of https://github.com/coasys/scryer-prolog into coasys-dashu 2023-07-24 11:47:57 -06:00
Fayeed Pawaskar
40b6890c54 updated cargo to use git 2023-07-24 19:11:41 +05:30
Fayeed Pawaskar
7248425a76 Fixed warnings 2023-07-24 12:41:56 +05:30
Fayeed Pawaskar
1dcc1ca524 Fixed stackoverflow error 2023-07-24 12:19:41 +05:30
Fayeed Pawaskar
0e17d6acd7 remove rug completely 2023-07-24 10:12:22 +05:30
Fayeed Pawaskar
c89217903a fix all the move errors 2023-07-24 10:12:14 +05:30
Mark
762e6d3ba4 pop both pending redirections in format_bar_separator_op when max depth exceeded (#1903) 2023-07-23 15:02:27 -06:00
Mark
e9ae80e250 fix list abbreviation (#1901) 2023-07-23 14:43:13 -06:00
Mark
fd7f24e265 remove EMIT_NEWLINE (#1900) 2023-07-22 21:42:40 -06:00
Mark
24450a8827 use ExitCode when halting so Drop is called, close terminal stream in rustyline Drop 2023-07-22 19:06:13 -06:00
Mark Thom
57e8ed65b0 Merge pull request #1050 from pmoura/add_float_integer_part_and_float_fractional_part_standard_functions
WIP: Add float_integer_part/1 and float_fractional_part/1 standard arithmetic functions
2023-07-22 13:48:16 -06:00
Mark
3f819e2dfd additional write fixes, use rustyline 12.0.0 (#1876, #1901) 2023-07-22 11:53:09 -06:00
Mark
9a7862c322 correct max_depth option (#1876) 2023-07-22 11:11:23 -06:00
Mark Thom
92c77cdff5 Merge pull request #1899 from triska/master
remove another !/0 which is now no longer necessary due to improved indexing
2023-07-21 23:26:20 -06:00
Markus Triska
554e956ef5 remove another !/0 which is now no longer necessary due to improved indexing 2023-07-22 06:52:29 +02:00
Nicolas Luck
9fd6e18d59 Dedupe machine results 2023-07-22 00:32:24 +02:00
Nicolas Luck
d8a9475460 Add missing list_last_item to lib_toplevel.pl and increase MaxDepth of write_eq to avoid truncation of results 2023-07-22 00:31:49 +02:00
Mark
60d9d01a55 Merge branch 'add_float_integer_part_and_float_fractional_part_standard_functions' of https://github.com/pmoura/scryer-prolog into pmoura-add_float_integer_part_and_float_fractional_part_standard_functions 2023-07-21 15:35:28 -06:00
Mark
cb79552dd0 correct max_depth option (#1876) 2023-07-21 15:05:27 -06:00
Mark
f310ff24a5 remove now unnecessary cut in lists.pl 2023-07-21 11:35:57 -06:00
Nicolas Luck
b1963864d2 Explicitly dereference pointer to avoid calling neg() on reference 2023-07-21 17:07:40 +02:00
Nicolas Luck
9e85be11fe Fix result parsing for complex string results 2023-07-21 14:35:44 +02:00
Fayeed Pawaskar
b4e7000eb2 Fixed missing functionality in dashu with their methods still has some issue with move 2023-07-21 14:21:32 +05:30
Nicolas Luck
0b833bd2f3 Add missing write_goal/3 to lib_toplevel.pl 2023-07-21 00:23:35 +02:00
Nicolas Luck
7c93450aa7 type QueryResult = Result<QueryResolution, String> 2023-07-20 22:31:20 +02:00
Mark
e529e7ba21 improve goal expansion and (',') interpretation error handling 2023-07-20 14:27:10 -06:00
Nicolas Luck
cae32d6a00 Error handling 2023-07-20 22:23:51 +02:00
Nicolas Luck
836f6c1d5b Don't panic when parsing results fails 2023-07-20 21:34:43 +02:00
Mark
1697cd5c7f add log10, hyperbolic tan and inverse hyperbolic tan functions (#1898) 2023-07-20 12:33:51 -06:00
Mark
dcd7360b17 add EMIT_NEWLINE to add newlines to readline input only after query terms begin to be read (#1074, #1897) 2023-07-20 09:39:06 -06:00
Mark
4fd247f881 check for unexpected EOF in get_to_eof (#1897) 2023-07-19 17:13:47 -06:00
Mark
85bc544fb9 dereference TermWriteResult variables sooner in read_term_body (#1894) 2023-07-18 15:39:51 -06:00
Mark
14646074be remove failing append choicepoint in atom_concat/3 special case (#1893) 2023-07-18 14:44:02 -06:00
Mark Thom
1ba040c24d Merge pull request #1885 from mthom/setof_bagof_fixes
Fix group_by_variants/4 and keysort in setof/3
2023-07-18 12:35:10 -06:00
Mark
56f6772422 call write_read_term_options if read_term_from_chars/3 succeeds by unifying Term to end_of_file (#1892) 2023-07-18 12:15:20 -06:00
Mark
db43d461b9 catch errors thrown from tabling Worker (#1526, #1888) 2023-07-18 12:10:27 -06:00
Mark
42a50474da remove read/{1,2} as a builtin, write read options upon EOF, throw better domain errors in parse_read_term_options/2 2023-07-17 16:45:03 -06:00
Mark
cf367024fd add specialized EOF handling for user input (#1892) 2023-07-17 14:38:26 -06:00
Nicolas Luck
644559b7f7 Add back newline at end of toplevel.pl 2023-07-17 21:52:17 +02:00
Nicolas Luck
bb95ed3ad0 Add back all needed predicates to lib_toplevel.pl 2023-07-17 21:48:05 +02:00
Nicolas Luck
3947390877 Use lib constructor in lib tests 2023-07-17 21:47:43 +02:00
Nicolas Luck
e7f1e32ee3 fmt machine/parsed_results.rs 2023-07-17 21:35:00 +02:00
Nicolas Luck
5f8cc3c64b WIP: refactor to generalize Machine::run_top_level() 2023-07-17 21:34:26 +02:00
Mark
67d198ac77 Merge branch 'read_term_eof_changes' 2023-07-17 13:22:51 -06:00
Mark
a154a34f87 omit anonymous variables from read_term variable_names and singletons lists 2023-07-17 13:20:10 -06:00
Mark
86c90d77dd do a better job handling EOF in read_term (#1887) 2023-07-17 13:19:30 -06:00
Mark
4e1a4dae6c print strings in tails of lists (#1890) 2023-07-17 11:38:50 -06:00
Fayeed Pawaskar
cf345d8174 wip dashu move 2023-07-17 20:40:41 +05:30
Mark Thom
a18da368a1 Merge pull request #1891 from triska/initialization_goals
ENHANCED: use newly available read_term_from_chars/3 for better errors
2023-07-16 10:26:13 -06:00
Markus Triska
5d3295c40c ENHANCED: use newly available read_term_from_chars/3 for better errors
Examples, previously:

    $ scryer-prolog -g "member(X,Ls"
    ?-
    $ scryer-prolog -g "member(X,Ls)"
    member(_542,_543) causes: error(existence_error(procedure,member/2),member/2)
    ?-

Now:

    $ scryer-prolog -g "member(X,Ls"
    "member(X,Ls" cannot be read: error(syntax_error(incomplete_reduction),read_term_from_chars/3:0)
    $ scryer-prolog -g "member(X,Ls)"
    member(X,Ls) causes: error(existence_error(procedure,member/2),member/2)
    ?-

This also addresses #1185.
2023-07-16 14:16:07 +02:00
Mark
de10ccfdee re-factor options handling of read_term into read_term_body (#1887) 2023-07-15 21:52:54 -06:00
Mark
65a8ce8e22 generalize simple goal detection to fix call/N test failures in logtalk test suite 2023-07-15 19:29:06 -06:00
Mark
5a7da721cd add read_term_from_chars/3 (#637) 2023-07-15 11:20:20 -06:00
Mark
b234ef7ea3 use double_quotes in write_error (#1886) 2023-07-15 10:58:25 -06:00
Mark
617c961f88 add is_inbuilt check to err_on_builtin_overwrite (#1872) 2023-07-15 10:44:00 -06:00
Mark
e95355e56e eliminate call_with_inference_limit/3 leaks (#1300) 2023-07-15 10:22:23 -06:00
Mark
ff5e9a793b add unknown flag to set_prolog_flag and current_prolog_flag 2023-07-14 19:10:10 -06:00
Mark
101d0548db fix group_by_variants/4 and keysort in setof/3 (#1440, #1856) 2023-07-14 18:52:29 -06:00
Mark
b6a81c51ab add (:-)/1 and (:-)/2 to ClauseType::is_inbuilt (#1872) 2023-07-14 12:44:28 -06:00
Mark
ba2cd43144 fix assert(a|z)/1 errors 2023-07-13 17:12:17 -06:00
Mark Thom
bd720b49f3 Merge pull request #1884 from triska/countall
ADDED: countall/2, for compatibility with GNU Prolog.
2023-07-13 16:09:29 -06:00
Markus Triska
9590d5200c ADDED: countall/2, for compatibility with GNU Prolog.
Example:

    ?- countall(member(X, "abc"), N).
       N = 3.
2023-07-13 23:08:13 +02:00
Mark
12f890e4a2 throw permission_error in compile_assert when attempting to assert a built-in (#1872) 2023-07-13 15:03:26 -06:00
Mark
a9cb826bf3 arith_eval_by_metacall may receive a stack variable 2023-07-13 13:58:51 -06:00
Mark
4163cb038d correct peek_code/2, don't set stream position in peek functions 2023-07-13 13:37:34 -06:00
Mark
b051f39145 correct peek_byte/2 bugs (#1882) 2023-07-13 12:23:20 -06:00
Mark
cfc49243c8 improve ground/1 performance (#1389) 2023-07-12 18:11:56 -06:00
Mark
29430ec88b fix peek_byte/2 crash (#1882) 2023-07-12 16:34:11 -06:00
Mark Thom
d520046a4f Merge pull request #1878 from mthom/lookahead_indexing
use lookahead to skip inapplicable clauses (#1028, #1502)
2023-07-12 16:21:06 -06:00
Markus Triska
814ce2d672 ENHANCED: improved determinism of member/2
Example:

    ?- member(X, "abc").
    %@    X = a
    %@ ;  X = b
    %@ ;  X = c.

This addresses #750.
2023-07-12 14:39:08 -06:00
Mark
4fd37335f5 use lookahead to skip inapplicable clauses (#1028, #1502) 2023-07-12 14:39:02 -06:00
Mark
1791bd8626 remove unsafe unwrap in put_char (#1881) 2023-07-12 14:24:20 -06:00
Mark
3f5dbc1680 emit stream aliases as permission error culprits whenever possible 2023-07-12 12:17:06 -06:00
Mark
44052cb373 Revert "Allow comparisons with stream terms"
This reverts commit 076a75d138.
2023-07-12 11:44:45 -06:00
Mark
8c33da11ce Revert "add stream alias check to atom/1 (#1855)"
This reverts commit b746a8f9ab.
2023-07-12 11:44:44 -06:00
Mark
ab80c84714 Revert "add stream alias processing to atom_chars/2, atom_codes/2"
This reverts commit 811ff65209.
2023-07-12 11:44:41 -06:00
Nicolas Luck
c0dd94c8a3 Add test for programatic queries 2023-07-12 11:57:53 +02:00
Nicolas Luck
f65675836c Fix build warnings 2023-07-12 11:38:53 +02:00
Nicolas Luck
f324c9591d Refactor result parsing to idiomatic Rust and extract into parsed_results.rs 2023-07-12 10:34:07 +02:00
Nicolas Luck
3347f830c7 Remove debug println!s 2023-07-12 01:26:54 +02:00
Nicolas Luck
568abef5b8 Parsed QueryResult 2023-07-12 01:24:39 +02:00
Nicolas Luck
703efdb22d Make run_input_once/0 match and print all results 2023-07-12 00:03:47 +02:00
Mark
bb420e9347 use indexing functions to set num_cells in allocate_and_frame/or_frame (#1877) 2023-07-11 13:43:34 -06:00
Nicolas Luck
2f45f0cfed Add convenience methods Machine::load_module_string() and Machine::run_query() 2023-07-11 14:51:58 +02:00
Nicolas Luck
112d398175 Add Machine::run_input_once() which reads one goal from user input and runs it 2023-07-11 14:24:30 +02:00
Nicolas Luck
95b31146b5 Add Machine::set_user_input(&mut self, input: String) and get_user_output() -> String. Make read_term_from_user_input() handle Stream::Byte. 2023-07-11 14:22:27 +02:00
Mark
55a1f8d3da clean commented code from disjuncts.rs 2023-07-10 10:32:15 -06:00
Mark
fba7790637 remove errant debug_hook from read_and_match 2023-07-09 10:30:30 -06:00
Markus Triska
918dfca409 DOC: new section on applications of Scryer Prolog
This addresses an important aspect of #1777.
2023-07-09 10:29:53 -06:00
Markus Triska
d18f128a3c correct \\ to \, addressing #1865 2023-07-09 10:29:53 -06:00
Mark
c8b9059289 refine EOF handling more (#1873) 2023-07-09 10:29:47 -06:00
Mark
b8a6882a27 refine EOF handling 2023-07-08 22:25:30 -06:00
Mark
fb8e3071f2 follow EOF action after open_parsing_stream in get_char if stream at EOF 2023-07-08 19:27:32 -06:00
Mark
067b5998ee clarify EOF error across stream types and predicates (#1867, #1870) 2023-07-08 13:38:52 -06:00
Mark Thom
2e26f37f5e Merge pull request #1869 from triska/master
print version more readably, addressing #1868
2023-07-08 01:24:04 -06:00
Markus Triska
6525c1f543 print version more readably, addressing #1868 2023-07-08 08:19:05 +02:00
Mark
4db0b385f3 treat unexpected EOF as incomplete reduction in bracketed_comment 2023-07-07 13:04:27 -06:00
Mark
b7f77d1747 interpret '\u{0}' as end_of_file in get_char/1 2023-07-07 11:05:44 -06:00
Mark
811ff65209 add stream alias processing to atom_chars/2, atom_codes/2 2023-07-07 10:38:05 -06:00
Mark Thom
fd70d8975b Merge pull request #1832 from aarroyoc/http-fixes
Multiple fixes for http libraries
2023-07-06 16:30:56 -06:00
Mark
b746a8f9ab add stream alias check to atom/1 (#1855) 2023-07-06 11:38:12 -06:00
Mark
483e4568a2 add scc_block to MachineState to avoid SCC cleanup terms being deallocated too early (#1427) 2023-07-06 11:20:49 -06:00
Mark
9ff1b660f1 correct heap_print.rs tests 2023-07-05 18:11:09 -06:00
Mark
5ffdd2d91a shrink scope of control_entry_point catch, add CutPoint tag to printer 2023-07-05 14:50:49 -06:00
Mark Thom
5b81bee941 Merge pull request #1864 from triska/double_quotes
make double_quotes write option not dependent on double_quotes flag
2023-07-05 13:49:29 -06:00
Markus Triska
3b9b9e75c4 make double_quotes write option not dependent on double_quotes flag
This gives consistent results without depending on another flag.
2023-07-05 21:37:11 +02:00
Mark Thom
faef45fd68 Merge pull request #1862 from mthom/iso_conformity_tests
Revise iso_conformity_tests.pl to remove unnecessary spaces
2023-07-05 10:49:51 -06:00
Mark
b5b45dde9d add missing self.pos to peek_char slices (#1726) 2023-07-04 17:44:27 -06:00
Mark
5ab087bc1e revise iso_conformity_tests.pl in response to new ambiguity check of #1860 2023-07-04 16:12:03 -06:00
Mark
7683367c0e throw lexer errors from devour_whitespace (#1778) 2023-07-04 16:09:54 -06:00
Mark Thom
d2db66b9f7 Merge pull request #1861 from aarroyoc/fix-1855
Allow comparisons with stream terms
2023-07-04 15:11:59 -06:00
Mark
c58d8804a1 widen CharReader buffer (#1859) 2023-07-04 15:08:46 -06:00
Mark
5d09449c95 widen CharReader buffer (#1859) 2023-07-04 11:22:22 -06:00
Adrián Arroyo Calle
076a75d138 Allow comparisons with stream terms 2023-07-04 17:33:48 +02:00
Mark Thom
7f69ac3f4a Merge pull request #1857 from triska/master
advertise newly achieved strong syntactic conformance: all current tests pass
2023-07-03 14:05:16 -06:00
Markus Triska
7f159a7ed2 advertise newly achieved strong syntactic conformance: all current tests pass
This addresses an important aspect of #1777.
2023-07-03 22:04:26 +02:00
Mark Thom
42274ef3ae Merge pull request #1850 from mthom/iso-conformity-tests
Automate ISO syntax conformity tests
2023-07-03 13:53:41 -06:00
Mark
ab893be418 update tests 2023-07-03 13:18:53 -06:00
Mark
f5e7573bd6 correct tests #171 and #300 2023-07-03 12:09:26 -06:00
Mark
9cdad087ef add double_quotes write option for printing to strings, enable it at toplevel 2023-07-03 12:09:05 -06:00
Mark
e36f96fd47 correct ISO conformity test #185 2023-07-03 11:34:41 -06:00
Mark
cb25a90250 add iso-conformity-tests.pl to test suite 2023-07-02 11:10:33 -06:00
Mark
38a9d23174 correct initialization_goals misnomer in iso-conformity-tests.pl 2023-07-02 11:10:33 -06:00
Mark
521118265a make setup of test_166_167 pass 2023-07-02 11:10:33 -06:00
Mark
a09306c585 check ambiguity of "'" against tail if atom token is about to be quoted 2023-07-02 11:10:33 -06:00
Mark
8140ff9154 always print a space between prefix operator and its operand 2023-07-02 11:10:33 -06:00
Mark
3cbe78cb9b correct tests 259 and 304 of tests-pl/iso-conformity-tests.pl 2023-07-02 11:10:33 -06:00
Mark
699afb2c00 introduce tests-pl/iso-conformity-tests.pl 2023-07-02 11:10:33 -06:00
Mark
d079a18459 removing residual debugging comments from format.pl 2023-07-02 11:10:25 -06:00
Mark
b0566e4150 use lexer to detect remaining layout in parse_number_from_string (#1773) 2023-06-30 17:18:10 -06:00
Mark Thom
c38a26e6cd Merge pull request #1854 from triska/needs_bracketing
remove now unneeded check
2023-06-30 15:43:45 -06:00
Markus Triska
31030738a4 remove now unneeded check 2023-06-30 22:14:00 +02:00
Mark
caf84a259e check that F in needs_bracketing/2 is an atom 2023-06-30 13:45:45 -06:00
Mark
1620824d3a do not enclose '(' as atom in brackets (#1487) 2023-06-30 12:06:07 -06:00
Mark Thom
1d2f5053d6 Merge pull request #1852 from triska/needs_bracketing
Improvements to needs_bracketing/2
2023-06-30 11:13:24 -06:00
Markus Triska
42282c6e6e remove unneeded case: only operator definitions should count, not quoting 2023-06-30 18:03:21 +02:00
Markus Triska
a3f8ddd24a remove subsumed case: F == Value means Arity =:= 0, now considered above 2023-06-30 18:02:43 +02:00
Markus Triska
bfe808a779 shorten needs_bracketing/2 2023-06-30 18:01:54 +02:00
Markus Triska
28065b0565 constrain bracketing to operators with pertaining arity
Example:

    ?- X = -->(a,b,c).
       X = -->(a,b,c).
2023-06-30 18:01:17 +02:00
Mark Thom
4953cfd10e Merge pull request #1851 from triska/operator_bracketing
bracket all operators that are direct operands of (=)/2
2023-06-30 00:26:18 -06:00
Markus Triska
db972de40c bracket all operators that are direct operands of (=)/2
This addresses #804.
2023-06-30 08:03:38 +02:00
Adrián Arroyo Calle
330e9ba4ef Multiple fixes for http libraries
* use reqwest for http_open (still uses Hyper underneath)
* use Hyper 1.0.0-rc3 for server
* Modify all internal handling of server
2023-06-29 23:43:37 +02:00
Mark
bb09de1805 fix ReadlineStream peek_char using CharReader 2023-06-29 14:58:15 -06:00
Mark
a6a0cef9fc read the cell written to by mark_var when needed in compile_is (#1846) 2023-06-29 12:58:15 -06:00
Mark
c36bd4dc07 introduce CutPoint heap tag so that they can be offset by call_continuation/1 2023-06-29 12:14:15 -06:00
Mark Thom
83f352b95e Merge pull request #1849 from triska/showterm
remove unneeded single quotes
2023-06-29 12:11:12 -06:00
Markus Triska
c84a5c3282 remove unneeded single quotes 2023-06-29 19:25:23 +02:00
Mark
58af615dd4 correct and generalize current_predicate/1 2023-06-28 17:31:43 -06:00
Mark
c4b13a2176 unify stack variables to streams in unify_constant (#1845) 2023-06-27 17:35:10 -06:00
Mark
039fffb339 better detect syntax errors in lexer.rs (#1771) 2023-06-27 16:39:20 -06:00
Mark Thom
8613513b9c Merge pull request #1844 from triska/copy_term_nat
use copy_term_nat/2
2023-06-27 15:26:33 -06:00
Markus Triska
ceb276b249 use copy_term_nat/2 2023-06-27 22:37:23 +02:00
Mark
16f281e3d1 enable unification of streams to alias atoms (#1823) 2023-06-27 12:23:40 -06:00
Mark
b593fffc7d support module resolution in current_predicate/1 (#1817) 2023-06-27 11:08:29 -06:00
Mark
ce890799bc fix builtin_predicate (#1819) 2023-06-27 10:41:15 -06:00
Mark
aa65287c3b remove tabling attributes in each module's attribute_goals//1 (#1825) 2023-06-27 10:31:10 -06:00
Mark
a6522d6317 properly account for partial string offsets in '$skip_max_list' (#1827) 2023-06-26 16:36:04 -06:00
Mark
0b45d42912 mark chunk boundary at beginning of disjunct in disjuncts.rs (#1843) 2023-06-24 17:18:00 -06:00
Mark
d9829a3606 fix string incompleteness (#1828) 2023-06-24 14:12:08 -06:00
Mark Thom
59766e2db4 Merge pull request #1842 from infogulch/release-on-tag
Fix tags trigger; bump MSRV to 1.65
2023-06-24 13:13:07 -06:00
infogulch
e52a4fbfc0 Bump msrv to 1.65 due to bumping rug to 1.19
https://gitlab.com/tspiteri/rug#version-1190-news-2023-01-06
2023-06-24 13:21:42 -05:00
infogulch
c05afb4705 Fix tags trigger 2023-06-24 13:05:57 -05:00
Mark
9f209dadd9 fix branch subsumption bug (#1840, #1841) 2023-06-24 10:59:29 -06:00
Mark Thom
2ec45b7413 Merge pull request #1838 from triska/get_line_to_chars
MODIFIED: read_line_to_chars/3 is now called get_line_to_chars/3
2023-06-24 09:19:22 -06:00
Mark
bf581879e6 update README 2023-06-24 09:11:30 -06:00
Markus Triska
9bc3757a9e another case of "read" --> "get", for an only internally used predicate 2023-06-24 11:48:28 +02:00
Markus Triska
18d0a74f23 MODIFIED: read_line_to_chars/3 is now called get_line_to_chars/3
This is for consistency with other I/O predicates, where "read" always
indicates Prolog terms. Please adjust your programs accordingly.
2023-06-24 11:47:32 +02:00
Mark
7a188744da correct code_walker.rs in light of compilation improvements 2023-06-23 16:53:18 -06:00
Mark
7f45ac3f7a Merge branch 'compiling_disj' 2023-06-23 15:45:04 -06:00
Mark
612861e010 correct reversions after rebase 2023-06-23 14:32:37 -06:00
Mark
fcae0d9fcf polish perm free list management 2023-06-23 14:11:31 -06:00
infogulch
f446939770 Add steps to publish binaries when releases are tagged 2023-06-23 14:11:31 -06:00
Mark
92853a6a12 free local cut variables after cut 2023-06-23 14:11:31 -06:00
Mark
4ad113a6f8 mark is/2 allocated permanent variables as safe, add CompareNumber terms to ClauseType::is_inlined 2023-06-23 14:11:31 -06:00
dependabot[bot]
89ed1aa8de Bump openssl from 0.10.48 to 0.10.55
Bumps [openssl](https://github.com/sfackler/rust-openssl) from 0.10.48 to 0.10.55.
- [Release notes](https://github.com/sfackler/rust-openssl/releases)
- [Commits](https://github.com/sfackler/rust-openssl/compare/openssl-v0.10.48...openssl-v0.10.55)

---
updated-dependencies:
- dependency-name: openssl
  dependency-type: indirect
...

Signed-off-by: dependabot[bot] <support@github.com>
2023-06-23 14:11:31 -06:00
Mark
d7f5675727 improve call/N implementation (#1829) 2023-06-23 14:11:31 -06:00
Mark
4d982d22c1 set_local_value does not make values safe (#1812) 2023-06-23 14:11:31 -06:00
Mark
5ed1802f0f read set_value args from temp regs of put_unsafe_value (#1812) 2023-06-23 14:11:31 -06:00
Markus Triska
2716381e7b FIXED: correct dereferencing in atom_codes/2 and number_codes/2.
This addresses #1818.

Test case:

    run :-
	    length(Ls, L),
	    portray_clause(L),
	    maplist(=(X), Ls),
	    X = Y,
	    Y = 12,
	    atom_codes(_, Ls),
	    false.
2023-06-23 14:11:31 -06:00
Adrián Arroyo Calle
c5c83d724a Rename INDEX.md to INDEX.dj and add banner about Scryer Prolog Meetup 2023-06-23 14:11:31 -06:00
Mark
749dedf477 read from machine stack in stackful pre-order iterator (#1812) 2023-06-23 14:11:31 -06:00
notoria
911c49c43f Compute correctly the domain of the remainder 2023-06-23 14:11:31 -06:00
notoria
770a682d8b Don't add variable
?- Z #= 0, Z #= X mod Y.
   Z = 0, clpz:(_A*Y#=X), clpz:(Y in inf.. -1\/1..sup) % Unexpected.

The expected result:
   Z = 0, clpz:(X mod Y#=0), clpz:(Y in inf.. -1\/1..sup).
2023-06-23 14:11:31 -06:00
notoria
73ca37ecca Remove and move comments 2023-06-23 14:11:31 -06:00
Mark
e0f49e8f43 optionally read from machine stack in stackful pre-order iterator (#1812) 2023-06-23 14:11:31 -06:00
Mark
dae34b6009 affirm integers as rational/1 (#1810) 2023-06-23 14:11:31 -06:00
Adrián Arroyo Calle
5850125d97 Update select crate to 0.6.0 and remove warning 2023-06-23 14:11:31 -06:00
Markus Triska
97bd778745 FIXED: correctly reset counter in reset_gensym/2 (#1807)
Many thanks to @infradig for detecting this issue and suggesting this
correction!
2023-06-23 14:11:31 -06:00
Markus Triska
43df2e2649 shorten gensym/2 2023-06-23 14:11:31 -06:00
Markus Triska
c2f2623471 extend logic to all control and whitespace characters
This addresses #1802.
2023-06-23 14:11:31 -06:00
Mark
8e4465315f use same logic to print Chars and Atoms (#1804) 2023-06-23 14:11:31 -06:00
Markus Triska
86beb222ae rely on first instantiated argument indexing in the definitions of foldl/N
This allows shorter and more natural definitions.
2023-06-23 14:11:31 -06:00
Markus Triska
5e124ccf44 ENHANCED: allow Roman numerals in strings
Example:

    ?- X = "ↁ".
       X = "ↁ".

This addresses #1790.
2023-06-23 14:11:31 -06:00
Markus Triska
47d4e6d2f9 FIXED: consistent read/write of further control characters, and non-breaking space
Example:

    ?- X = '\xa0\'.
       X = '\xa0\'.

This addresses #1768.
2023-06-23 14:11:31 -06:00
Mark
33f65210ee make tests compatible 2023-06-23 14:11:31 -06:00
Mark
9ea6cb4cab backtrack on emission of unsafe register instructions on internal branches 2023-06-23 14:11:31 -06:00
Mark
0e583d620a implement new disjunction compilation 2023-06-23 14:11:31 -06:00
Mark Thom
b205abe949 remove BuildIf, BuildNot, BuildThen TermIterState variants 2023-06-23 14:11:31 -06:00
Mark Thom
cb59c3003a correct chunk type labeling 2023-06-23 14:11:30 -06:00
Mark Thom
942095baa7 remove GetLevelAndUnify and replace it with GetCutPoint 2023-06-23 14:11:30 -06:00
Mark Thom
097849385e add QueryTerm::ChunkTypeBoundary 2023-06-23 14:11:30 -06:00
Mark Thom
c4783062ff delete ChunkedTerm, chunked iteration 2023-06-23 14:11:30 -06:00
Mark Thom
063cf0c608 new TermIterState variants 2023-06-23 14:11:30 -06:00
Mark Thom
a66d666bed variable classification al a carte 2023-06-23 14:11:22 -06:00
Mark Thom
170818759d add more variable probing, chunk type labeling 2023-06-23 14:11:07 -06:00
Mark Thom
e41d1b319b adapt code generation 2023-06-23 14:11:04 -06:00
Mark Thom
b9c9de5222 add classifications and occurrence counting 2023-06-23 13:54:46 -06:00
Mark Thom
d565f5901b milestone marker for surgery 2023-06-23 13:54:04 -06:00
Mark Thom
46317c3a39 begin adapting the techniques of "Compiling Large Disjunctions" 2023-06-23 13:52:24 -06:00
Mark Thom
bcc5bff376 Merge pull request #1834 from infogulch/ci-publish-releases
Add steps to publish binaries when releases are tagged
2023-06-23 12:01:32 -06:00
infogulch
5244d71570 Add steps to publish binaries when releases are tagged 2023-06-22 23:36:04 -05:00
Mark Thom
9fac289d9a Merge pull request #1833 from mthom/dependabot/cargo/openssl-0.10.55
Bump openssl from 0.10.48 to 0.10.55
2023-06-22 11:30:56 -06:00
dependabot[bot]
de665c05d8 Bump openssl from 0.10.48 to 0.10.55
Bumps [openssl](https://github.com/sfackler/rust-openssl) from 0.10.48 to 0.10.55.
- [Release notes](https://github.com/sfackler/rust-openssl/releases)
- [Commits](https://github.com/sfackler/rust-openssl/compare/openssl-v0.10.48...openssl-v0.10.55)

---
updated-dependencies:
- dependency-name: openssl
  dependency-type: indirect
...

Signed-off-by: dependabot[bot] <support@github.com>
2023-06-21 22:54:36 +00:00
Mark
98b0ab3409 improve call/N implementation (#1829) 2023-06-10 17:32:18 -06:00
Mark
3c344b176b set_local_value does not make values safe (#1812) 2023-06-06 00:58:44 -06:00
Mark
6093c2858d read set_value args from temp regs of put_unsafe_value (#1812) 2023-05-29 20:49:54 -06:00
Mark Thom
e06ab1ca1c Merge pull request #1822 from triska/master
FIXED: correct dereferencing in atom_codes/2 and number_codes/2.
2023-05-29 10:15:43 -06:00
Markus Triska
5154314786 FIXED: correct dereferencing in atom_codes/2 and number_codes/2.
This addresses #1818.

Test case:

    run :-
	    length(Ls, L),
	    portray_clause(L),
	    maplist(=(X), Ls),
	    X = Y,
	    Y = 12,
	    atom_codes(_, Ls),
	    false.
2023-05-29 11:43:56 +02:00
Mark Thom
fa07306f09 Merge pull request #1820 from aarroyoc/banner-meetup
Rename INDEX.md to INDEX.dj and add banner about Scryer Prolog Meetup
2023-05-28 16:39:05 -06:00
Adrián Arroyo Calle
07115ce4f5 Rename INDEX.md to INDEX.dj and add banner about Scryer Prolog Meetup 2023-05-29 00:29:53 +02:00
Mark
b656700294 read from machine stack in stackful pre-order iterator (#1812) 2023-05-28 12:59:01 -06:00
Mark Thom
7bc7f0ad06 Merge pull request #1816 from notoria/clpz
Small fixes for `CLP(ℤ)`
2023-05-27 11:07:50 -06:00
notoria
495df8846a Compute correctly the domain of the remainder 2023-05-27 13:47:14 +02:00
notoria
05d48cdcc3 Don't add variable
?- Z #= 0, Z #= X mod Y.
   Z = 0, clpz:(_A*Y#=X), clpz:(Y in inf.. -1\/1..sup) % Unexpected.

The expected result:
   Z = 0, clpz:(X mod Y#=0), clpz:(Y in inf.. -1\/1..sup).
2023-05-27 13:41:04 +02:00
notoria
dc02be4944 Remove and move comments 2023-05-27 13:08:25 +02:00
Mark
462097d956 optionally read from machine stack in stackful pre-order iterator (#1812) 2023-05-26 15:19:07 -06:00
Mark
0e374c2e96 affirm integers as rational/1 (#1810) 2023-05-24 13:58:43 -06:00
Mark Thom
94a1313916 Merge pull request #1809 from aarroyoc/update-select
Update select crate to 0.6.0 and remove warning
2023-05-18 12:31:44 -06:00
Adrián Arroyo Calle
b54a4afad6 Update select crate to 0.6.0 and remove warning 2023-05-17 18:19:19 +02:00
Mark Thom
c71b8e05f0 Merge pull request #1808 from triska/gensym
gensym-related improvement and correction
2023-05-16 15:55:39 -06:00
Markus Triska
021c01dfd0 FIXED: correctly reset counter in reset_gensym/2 (#1807)
Many thanks to @infradig for detecting this issue and suggesting this
correction!
2023-05-16 22:42:57 +02:00
Markus Triska
30f222b837 shorten gensym/2 2023-05-16 22:41:20 +02:00
Mark Thom
f7d9237bb9 Merge pull request #1805 from triska/master
extend logic to all control and whitespace characters
2023-05-14 23:27:49 -06:00
Markus Triska
49addc7b04 extend logic to all control and whitespace characters
This addresses #1802.
2023-05-14 09:25:08 +02:00
Mark
2f9996f9ac use same logic to print Chars and Atoms (#1804) 2023-05-10 00:04:35 -06:00
Mark Thom
c1218fc986 Merge pull request #1801 from triska/foldl
rely on first instantiated argument indexing in the definitions of foldl/N
2023-05-04 21:25:16 -06:00
Mark Thom
57ef706eb0 Merge pull request #1799 from triska/roman_numerals
ENHANCED: allow Roman numerals in strings
2023-05-04 21:25:03 -06:00
Mark Thom
e4b19dc1dd Merge pull request #1800 from triska/nbsp
FIXED: consistent read/write of further control characters, and non-breaking space
2023-05-04 21:24:45 -06:00
Markus Triska
4e60cc46a2 rely on first instantiated argument indexing in the definitions of foldl/N
This allows shorter and more natural definitions.
2023-05-04 00:50:27 +02:00
Markus Triska
d8edf7bfff FIXED: consistent read/write of further control characters, and non-breaking space
Example:

    ?- X = '\xa0\'.
       X = '\xa0\'.

This addresses #1768.
2023-05-03 23:29:22 +02:00
Markus Triska
e951db662d ENHANCED: allow Roman numerals in strings
Example:

    ?- X = "ↁ".
       X = "ↁ".

This addresses #1790.
2023-05-03 22:02:47 +02:00
Mark
c5a3ec3ba8 fix current_predicate/1 (#1761) 2023-04-24 23:23:27 -06:00
Mark Thom
f12a90351a Merge pull request #1794 from aarroyoc/uppercase-2
Fix to_upper/to_lower when string is instantiated
2023-04-23 17:08:21 -06:00
Adrián Arroyo Calle
b162c40007 Fix to_upper/to_lower when string is instantiated 2023-04-23 23:01:29 +02:00
Mark Thom
402100fd52 Merge pull request #1797 from triska/clpb_residuals
remove residual goal for ground BDD
2023-04-23 10:31:40 -06:00
Markus Triska
2a1b8f37ec remove residual goal for ground BDD
Example:

    ?- sat(X).
       X = 1.
2023-04-23 09:23:00 +02:00
Mark
7d2e59ab64 discard CodeIndex literals from unfolded control operators in preprocessor (#1791) 2023-04-22 18:38:50 -06:00
Mark
f35298a227 add and document inlined_instructions/2 to/in diag.pl (#1791) 2023-04-22 18:38:49 -06:00
Mark Thom
198e925430 Merge pull request #1796 from triska/dif_si
ADDED: dif_si/2
2023-04-22 17:21:03 -06:00
Markus Triska
8b7281fad0 ADDED: dif_si/2
Source: https://stackoverflow.com/questions/20223390/prolog-a-person-is-a-sibling-of-himself

In Scryer Prolog, this is actually not needed, since Scryer Prolog provides
dif/2 in library(dif). However, it is still useful to provide dif_si/2 for two reasons:

  1) to more easily port code from systems where only dif_si/2 is available
  2) to provide correct disequality in other systems that adopt this library
2023-04-23 00:37:14 +02:00
Mark Thom
502574dfc3 Merge pull request #1795 from infogulch/fix-ci-install
Use --force to install cargo2junit
2023-04-22 16:03:39 -06:00
infogulch
7a0f4e5787 Use --force to install cargo2junit
This probably appeared now because it's the first time this tool was cached
from a previous run.
2023-04-22 15:42:10 -05:00
Mark Thom
f277f660f3 Merge pull request #1793 from infogulch/fix-action-ref
Change ref for `publish-unit-test-result-action`
2023-04-22 11:26:45 -06:00
infogulch
9c037d6028 Change ref for publish-unit-test-result-action 2023-04-22 10:18:10 -05:00
Mark Thom
396528189d Merge pull request #1789 from aarroyoc/uppercase
library(charsio): add to_upper and to_lower
2023-04-20 07:17:09 +02:00
Adrián Arroyo Calle
4b882c465c library(charsio): add to_upper and to_lower 2023-04-18 18:58:09 +02:00
Mark Thom
8937cac47d Merge pull request #1783 from infogulch/test
Refactor CI Workflow
2023-04-18 08:35:45 +02:00
infogulch
5a3e2899dd Refactor CI Workflow
* Rename the workflow from Test to CI, since it does more than tests
* Run logtalk tests in a separate job to improve isolation
* Publish all xunit/junit test files as build artifacts to be consumed
  by a separate publishing workflow.
* Add "job summary" feature to show a formatted summary of the test
  results on the job summary status page
* Run the CI job once every Wed to ensure that there are always some
  recent builds on master that haven't expired.
2023-04-14 14:55:49 -05:00
Mark Thom
3a5ed4723b Merge pull request #1785 from mthom/dependabot/cargo/h2-0.3.17
Bump h2 from 0.3.15 to 0.3.17
2023-04-14 06:22:32 +02:00
Mark Thom
dcf4c44173 Merge pull request #1786 from triska/tuples_in
FIXED: propagation for ground tuples
2023-04-14 06:22:18 +02:00
Markus Triska
5763a4b9df FIXED: propagation for ground tuples
Example:

    ?- tuples_in([[A,A]],[[0,1],[2,0]]).
       false.

See https://github.com/triska/clpz/issues/22.
2023-04-13 23:39:45 +02:00
dependabot[bot]
82200a21eb Bump h2 from 0.3.15 to 0.3.17
Bumps [h2](https://github.com/hyperium/h2) from 0.3.15 to 0.3.17.
- [Release notes](https://github.com/hyperium/h2/releases)
- [Changelog](https://github.com/hyperium/h2/blob/master/CHANGELOG.md)
- [Commits](https://github.com/hyperium/h2/compare/v0.3.15...v0.3.17)

---
updated-dependencies:
- dependency-name: h2
  dependency-type: indirect
...

Signed-off-by: dependabot[bot] <support@github.com>
2023-04-13 17:03:50 +00:00
Mark Thom
fc7d98d748 Merge pull request #1780 from triska/tuples_in
Various improvements to tuples_in/2
2023-04-12 19:10:50 +02:00
Markus Triska
5dce7d9075 FIXED: enforce equality also for ground elements in tuples
Example:

    ?- tuples_in([[A,B]], [[1,2],[3,4]]),
       tuples_in([[A,B]], [[3,2]]).
       false.

See https://github.com/SWI-Prolog/swipl-devel/issues/1160.
2023-04-11 22:33:19 +02:00
Markus Triska
f08f539768 do not create attributed variables for ground tuples 2023-04-11 21:26:18 +02:00
Markus Triska
be45672e22 actually disable and reenable the queue 2023-04-11 21:26:18 +02:00
Markus Triska
94efb9ffe3 remove no longer needed clpz_relation attributes 2023-04-11 21:26:18 +02:00
Markus Triska
fd1e902492 do not leave an attribute when (re-)enabling a queue 2023-04-11 21:14:18 +02:00
Mark Thom
8d6e3d7d56 Merge pull request #1776 from infogulch/master
Add iso prolog / logtalk tests to test runner
2023-04-07 06:09:08 +02:00
infogulch
a197bb6815 Allow the test suite to fail without failing the build 2023-04-06 09:40:03 -05:00
infogulch
9de8456c7f Add logtalk test suite 2023-04-02 17:31:20 -05:00
infogulch
ebf8091dba Test workflow cleanup; switch to macos-11 2023-04-02 14:47:52 -05:00
Mark Thom
47ce84b273 Merge pull request #1772 from triska/number_chars
FIXED: number_chars(N, "0' "), addressing #1580.
2023-04-02 19:24:59 +02:00
Mark Thom
449e097f4a Merge pull request #1774 from infogulch/master
Optimize Test GH action
2023-04-02 19:24:36 +02:00
Markus Triska
fe27605497 FIXED: number_chars(N, "0' "), addressing #1580.
There may be a more elegant way to solve this.
2023-04-02 10:04:52 +02:00
infogulch
8792ee438c Add cache step to test workflow 2023-04-02 02:09:41 -05:00
Mark Thom
7279062d3c Merge pull request #1770 from triska/doc
Smaller documentation improvements to explain compilation and target directory
2023-04-01 23:28:19 +02:00
Markus Triska
b87fe1e21f DOC: link to "Indexing dif/2" 2023-04-01 11:04:37 +02:00
Markus Triska
d6ac125425 DOC: explain location of scryer-prolog after compilation
This question was recently raised on the #scryer IRC channel.
2023-04-01 11:04:37 +02:00
Markus Triska
b79d8732ea use the release flag so that the instructions can be used verbatim
Also, the location of the executable depends on this flag.
2023-04-01 11:04:33 +02:00
Markus Triska
3df0806017 change "run" to "build", since "run" leads to a Scryer prompt which can be unexpected 2023-04-01 11:03:31 +02:00
Mark Thom
c7759aa737 Merge pull request #1769 from triska/show_pending_constraints
ENHANCED: use call_residue_vars/2 to show all pending constraints
2023-03-31 04:51:34 +02:00
Markus Triska
8ab1155fc5 ENHANCED: use call_residue_vars/2 to show all pending constraints
Example:

    ?- freeze(_, false).
       freeze:freeze(_A,false).

This was originally added in 04ba9bc11a,
then reverted, and is now restored.
2023-03-30 23:49:33 +02:00
Mark Thom
adc77985d7 broaden the definition of alpha_char! (#1749, #1515, #1591) 2023-03-26 11:10:46 -06:00
Mark Thom
d85fc7c9f8 Merge pull request #1765 from mthom/dependabot/cargo/openssl-0.10.48
Bump openssl from 0.10.42 to 0.10.48
2023-03-25 06:20:00 +01:00
dependabot[bot]
41b083c962 Bump openssl from 0.10.42 to 0.10.48
Bumps [openssl](https://github.com/sfackler/rust-openssl) from 0.10.42 to 0.10.48.
- [Release notes](https://github.com/sfackler/rust-openssl/releases)
- [Commits](https://github.com/sfackler/rust-openssl/compare/openssl-v0.10.42...openssl-v0.10.48)

---
updated-dependencies:
- dependency-name: openssl
  dependency-type: indirect
...

Signed-off-by: dependabot[bot] <support@github.com>
2023-03-25 01:27:40 +00:00
Mark Thom
4ee6a7bfb8 add '$unattributed_var' builtin (#1758) 2023-03-18 23:08:38 -06:00
Mark Thom
6e53d08d40 Merge pull request #1759 from triska/better_queue
Better queue
2023-03-16 04:34:33 +01:00
Markus Triska
01285f12c3 remove no longer needed queue attributes after propagation 2023-03-15 21:17:06 +01:00
Markus Triska
cd586aab8c show remaining queue/2 attributes as residual goals
This lets us verify that all attributes are correctly removed earlier.
2023-03-15 19:56:02 +01:00
Mark Thom
4da646252b Revert "correct call_residue_vars/3 using new copy_term_3 (#1239)"
This reverts commit 9b35a316c9.
2023-03-14 21:34:49 -06:00
Mark Thom
cc8bb38abc Revert "use new call_residue_vars/2 in toplevel.pl (#847)"
This reverts commit 04ba9bc11a.
2023-03-14 21:34:48 -06:00
Mark Thom
04ba9bc11a use new call_residue_vars/2 in toplevel.pl (#847) 2023-03-12 17:56:54 -06:00
Mark Thom
9b35a316c9 correct call_residue_vars/3 using new copy_term_3 (#1239) 2023-03-12 17:56:54 -06:00
Mark Thom
3a522f3c98 Merge pull request #1757 from aarroyoc/fix-docs-1756
DOCS: Fixes #1756
2023-03-12 18:26:54 +01:00
Adrián Arroyo Calle
4c44859132 Fixes #1756 2023-03-12 16:47:20 +01:00
Mark Thom
ecd77f7512 Merge pull request #1755 from triska/doc
various smaller documentation improvements
2023-03-10 02:40:29 +01:00
Markus Triska
56bd596af3 use actual toplevel answers 2023-03-08 23:35:11 +01:00
Markus Triska
21acb9361a use string notation as discussed on #scryer IRC 2023-03-08 23:32:05 +01:00
Markus Triska
c3477d8476 items --> elements
This addresses #1740.
2023-03-08 23:31:02 +01:00
Mark Thom
cba09d4ea1 Merge pull request #1754 from triska/dif
ENHANCED: more compact definition of dif/2
2023-03-08 21:48:34 +01:00
Markus Triska
884b0ca10e FIXED: Take all variables into account during goal projection.
This addresses #1751.
2023-03-08 21:16:54 +01:00
Markus Triska
c9ecfb11d9 ENHANCED: more compact definition of dif/2
As outlined in #1753.
2023-03-08 20:50:33 +01:00
Mark Thom
9288dcabe9 Merge pull request #1744 from aarroyoc/ffi
Foreign Function Interface - library(ffi)
2023-03-02 21:57:56 +01:00
Adrián Arroyo Calle
73df96244d Fill more cases 2023-03-01 22:13:04 +01:00
Adrián Arroyo Calle
7396630627 Merge branch 'master' into ffi 2023-02-28 22:10:40 +01:00
Adrián Arroyo Calle
0ac93751d0 FFI: Documentation 2023-02-28 22:09:35 +01:00
Mark Thom
400ca21213 invoke '$default_attr_list' in project_attributes.pl (#1748) 2023-02-26 22:42:02 -07:00
Mark Thom
3286e78cd2 third argument of copy_term should be instantiated as a list (#1747) 2023-02-26 22:42:02 -07:00
Mark Thom
24eb9ce483 Merge pull request #1746 from triska/type_over_instantiation_error
ENHANCED: must_be/2: prefer type error over instantiation error
2023-02-26 23:46:23 +01:00
Markus Triska
3dc6ed79d2 ENHANCED: must_be/2: prefer type error over instantiation error
This addresses #1594.
2023-02-26 22:28:18 +01:00
Adrián Arroyo Calle
f94294dbd9 FFI: Nested structs 2023-02-26 20:48:00 +01:00
Mark Thom
04ba58067a add, implement and use the Unifier trait 2023-02-26 12:21:22 -07:00
Adrián Arroyo Calle
92b262d599 Macroization of the code 2023-02-25 22:27:28 +01:00
Mark Thom
7ffb40e0ad Merge pull request #1743 from triska/rely_on_indexing
rely on first instantiated argument indexing
2023-02-25 19:23:59 +01:00
Markus Triska
997161c740 rely on first instantiated argument indexing
This great improvement to indexing allows much more natural
definitions of virtually all meta-predicates. Many thanks to @notoria!
2023-02-25 10:17:55 +01:00
Mark Thom
84c95c59e9 Merge pull request #1741 from triska/clpz_residuals
in projection of residual goals, mark considered propagators as processed
2023-02-23 01:51:22 +01:00
Markus Triska
669242a8ce DOC: update residual goals 2023-02-23 00:10:36 +01:00
Markus Triska
2a04d5e799 in projection of residual goals, mark considered propagators as processed
This is to avoid duplicated goals with the new projection mechanism.
2023-02-23 00:05:27 +01:00
Adrián Arroyo Calle
9d52d2a653 MVP of Foreign Function Interface 2023-02-22 23:10:03 +01:00
Mark Thom
95f6ebc000 assign responsibility for emitting dif goal to the first variable of the left-hand term (#1739) 2023-02-22 10:28:29 -07:00
Mark Thom
6e9cd072c5 catch attribute_goals errors in copy_term/3, don't discard variable module qualifiers in dcg_body/3 (#1738) 2023-02-21 00:50:46 -07:00
Mark Thom
729f2b1cb9 Merge pull request #1737 from triska/link_to_homepage
add link to newly available homepage
2023-02-20 21:10:01 +01:00
Markus Triska
1a01438064 add link to newly available homepage
Many thanks to @aarroyoc for the documentation system, and for hosting the page!
2023-02-20 20:09:47 +01:00
Robert Jacobson
34ec6d3167 Changed the links for the delimited continuations papers and the precise garbage collection paper. 2023-02-20 01:11:52 -07:00
Robert Jacobson
c9295323f6 Added links to referenced research papers in the Phase 2 and Nice to Have Features sections. 2023-02-20 01:11:52 -07:00
Mark Thom
92d543b8a8 change '$delete_all_attributes' to '$delete_all_attributes_from_var' 2023-02-20 01:11:52 -07:00
Mark Thom
3f445c76be add '$delete_all_attributes', use copy_term/3 as defined in #1272 2023-02-20 01:11:51 -07:00
Mark Thom
a6e416f13d compile '$atts' and '$project_atts' modules using loader.pl 2023-02-20 01:11:35 -07:00
Mark Thom
601ff567e3 keep phrase goal qualified even if qualifier is a variable 2023-02-17 00:20:15 -07:00
Mark Thom
56783b8e4b correct incremental compilation bugs 2023-02-12 23:41:25 -07:00
Mark Thom
326f18ea75 copy attributed variable attribute lists specially via copy_attr_var_list 2023-02-12 17:30:04 -07:00
Mark Thom
491472a8c5 retire TrailedAttrVarHeapLink TrailEntry tag 2023-02-10 22:52:27 -07:00
Mark Thom
359619e035 simplify and optimize attributed variables (#1590, #1634, #1730) 2023-02-10 21:56:42 -07:00
Mark Thom
9454d670c7 port '$get_from_list' to '$get_from_attr_list' in Rust 2023-02-06 01:23:29 -07:00
Mark Thom
2fcec4fff9 include wambook errata 2023-02-04 18:14:16 -07:00
Mark Thom
2c2a9fe01e correct shl stub_gen 2023-02-03 22:27:15 -07:00
Mark Thom
165a55dac6 Merge pull request #1734 from triska/clpz_corrections
DOC: teletype font for reification
2023-02-04 05:49:11 +01:00
Markus Triska
196e9c1e47 DOC: teletype font for reification 2023-02-03 20:47:08 +01:00
Mark Thom
17450520ba shift by usize instead of u32 in shl and shr (#1718, #1719) 2023-02-02 20:49:39 -07:00
Mark Thom
97702f3071 Merge pull request #1732 from aarroyoc/docs-minor-fixes
Minor fixes to docs
2023-02-03 01:58:52 +01:00
Adrián Arroyo Calle
e8408ca93f Minor fixes to docs 2023-02-02 21:35:35 +01:00
Mark Thom
e0dcf88b68 Merge pull request #1731 from triska/clpz_corrections
correct DocLog ~/.scryerrc rendering
2023-02-02 06:26:08 +01:00
Mark Thom
cc38cf15a4 Merge pull request #1729 from aarroyoc/negative-shifts
Negative shifts (fixes #1719 and #1718)
2023-02-02 06:25:52 +01:00
Markus Triska
da4c0a359b correct DocLog ~/.scryerrc rendering 2023-02-01 23:26:52 +01:00
Mark Thom
ce56a7303e avoid arena allocation of stream in read_term_from_chars (#1266) 2023-01-31 00:15:57 -07:00
Mark Thom
5667ec8699 update tokio version 2023-01-30 23:27:07 -07:00
Adrián Arroyo Calle
36b3150225 Negative shifts (fixes #1719 and #1718) 2023-01-30 18:56:37 +01:00
Mark Thom
28c338416f Merge pull request #1728 from aarroyoc/docs-csv
Compatible Doclog docs for library(csv)
2023-01-30 04:24:04 +01:00
Mark Thom
26a8fc1a37 Merge pull request #1727 from triska/clpz_corrections
DOC: use valid Prolog terms as predicate indicators
2023-01-30 04:23:52 +01:00
Adrián Arroyo Calle
f347baafa3 Compatible Doclog docs for library(csv) 2023-01-29 22:36:16 +01:00
Markus Triska
95278c221b DOC: use valid Prolog terms as predicate indicators 2023-01-29 21:48:22 +01:00
Mark Thom
5a28366158 Merge pull request #1725 from aarroyoc/fix-docs-http-server
Fix library(http/http_server) docs. Other minor fixes
2023-01-28 20:12:09 +01:00
Mark Thom
ac0cea8a73 Merge pull request #1724 from triska/clpz_corrections
CLP(ℤ) corrections
2023-01-28 20:11:48 +01:00
Markus Triska
814b631543 use DocLog syntax for section anchors and links within the document 2023-01-28 17:37:43 +01:00
Markus Triska
0d8c7f8785 small documentation adjustments 2023-01-28 17:37:43 +01:00
Markus Triska
5bae8fcaf8 FIXED: use lsb/2 and msb/2 from library(arithmetic)
This addresses #1720.
2023-01-28 17:37:43 +01:00
Adrián Arroyo Calle
4110cfcfcb Fix library(http/http_server) docs. Other minor fixes 2023-01-28 16:00:27 +01:00
Mark Thom
2bdba261ea Merge pull request #1717 from triska/format_doc
correct table layout for entries that themselves contain |
2023-01-27 07:47:53 +01:00
Markus Triska
58fb851717 correct table layout for entries that themselves contain | 2023-01-27 00:22:48 +01:00
Mark Thom
1118b37c92 Merge pull request #1674 from aarroyoc/docs-builtins
Compatible Doclog docs for builtins
2023-01-26 05:10:20 +01:00
Mark Thom
39606a2277 Merge pull request #1705 from triska/format_doc
DOC: convert library(format) documentation to DocLog format
2023-01-26 02:05:23 +01:00
Mark Thom
275d306b69 Merge pull request #1706 from triska/si_doc
DOC: convert library(si) documentation to DocLog format
2023-01-26 02:03:24 +01:00
Mark Thom
e948413c09 Merge pull request #1707 from triska/reif_doc
DOC: add link to "Indexing dif/2" in DocLog format
2023-01-26 02:03:14 +01:00
Mark Thom
f8bb3148d0 Merge pull request #1708 from triska/freeze_doc
DOC: add documentation for library(freeze) in DocLog format
2023-01-26 02:02:58 +01:00
Mark Thom
e7cf70936a Merge pull request #1709 from triska/pio_doc
DOC: convert library(pio) documentation to DocLog format
2023-01-26 02:02:47 +01:00
Mark Thom
409287e8f8 Merge pull request #1710 from triska/tabling_doc
DOC: initial documentation for library(tabling) in DocLog format
2023-01-26 02:02:35 +01:00
Mark Thom
87d6ef16f7 Merge pull request #1711 from triska/pairs_doc
DOC: initial documentation for library(pairs) in DocLog format
2023-01-26 02:02:22 +01:00
Mark Thom
3c08eba559 Merge pull request #1712 from triska/lambda_doc
DOC: convert code samples in library(lambda) to DocLog format
2023-01-26 02:02:12 +01:00
Mark Thom
d399b68d01 Merge pull request #1713 from triska/simplex_doc
DOC: convert library(simplex) documentation to DocLog format
2023-01-26 02:02:01 +01:00
Markus Triska
2e9ec653a8 DOC: convert library(simplex) documentation to DocLog format 2023-01-26 00:46:06 +01:00
Markus Triska
7ca782b92d DOC: convert code samples in library(lambda) to DocLog format 2023-01-26 00:40:08 +01:00
Markus Triska
996496c3f5 DOC: initial documentation for library(pairs) in DocLog format 2023-01-26 00:36:05 +01:00
Markus Triska
90cf713186 add link to Desouter et al., "Tabling as a Library with Delimited Control" 2023-01-26 00:25:26 +01:00
Markus Triska
ca4aaf44de DOC: initial documentation for library(tabling) in DocLog format 2023-01-26 00:20:53 +01:00
Markus Triska
b04d845ec0 DOC: convert library(pio) documentation to DocLog format 2023-01-26 00:09:41 +01:00
Markus Triska
a8ea2b0f97 DOC: add documentation for library(freeze) in DocLog format 2023-01-25 23:54:30 +01:00
Markus Triska
a29227d0d4 DOC: add link to "Indexing dif/2" in DocLog format 2023-01-25 23:40:55 +01:00
Markus Triska
7f8f137aa0 DOC: convert library(si) documentation to DocLog format 2023-01-25 23:27:45 +01:00
Markus Triska
cc7e721611 DOC: convert library(format) documentation to DocLog format 2023-01-25 23:18:39 +01:00
Mark Thom
058cbcf19a Merge pull request #1704 from triska/time_doc
DOC: correctly format the table using DocLog syntax
2023-01-25 22:51:05 +01:00
Markus Triska
22b815dc5c DOC: correctly format the table using DocLog syntax 2023-01-25 22:29:14 +01:00
Mark Thom
c709853aa7 Merge pull request #1703 from aarroyoc/docs-arithmetic
Compatible Doclog docs for library(arithmetic) and small fixes on INDEX.md
2023-01-25 21:40:15 +01:00
Adrián Arroyo Calle
d755bb7e12 Apply feedback on builtins 2023-01-25 21:04:10 +01:00
Adrián Arroyo Calle
6d99912b7b Compatible Doclog docs for library(arithmetic) and small fixes on INDEX.md 2023-01-25 19:48:01 +01:00
Mark Thom
82dd9e0596 Merge pull request #1701 from triska/diag_doc
DOC: add DocLog documentation for library(diag)
2023-01-25 00:16:53 +01:00
Mark Thom
6ba3d49034 Merge pull request #1702 from triska/debug_doc
DOC: add DocLog documentation for library(debug)
2023-01-25 00:16:34 +01:00
Markus Triska
64be8e0fba DOC: add DocLog documentation for library(debug) 2023-01-25 00:19:14 +01:00
Markus Triska
43a297b691 DOC: add DocLog documentation for library(diag) 2023-01-25 00:09:44 +01:00
Mark Thom
df266378c4 Merge pull request #1689 from triska/clpb_doc
DOC: preliminary CLP(B) documentation in DocLog format
2023-01-24 22:51:35 +01:00
Mark Thom
ec55765cb2 Merge pull request #1697 from triska/crypto_doc
DOC: convert library(crypto) documentation to DocLog format
2023-01-24 22:46:14 +01:00
Mark Thom
de2ff8118f Merge pull request #1696 from triska/clpz_doc
DOC: improve CLP(ℤ) DocLog documentation
2023-01-24 22:45:51 +01:00
Mark Thom
c30c9dc98f Merge pull request #1698 from triska/time_doc
DOC: convert library(time) documentation to DocLog format
2023-01-24 22:43:53 +01:00
Mark Thom
1f872c3f0c Merge pull request #1694 from aarroyoc/docs-dcgs
Compatible Doclog docs for library(dcgs)
2023-01-24 22:43:43 +01:00
Mark Thom
b6204eb6f1 Merge pull request #1699 from triska/sgml_doc
DOC: convert library(sgml) documentation to DocLog format
2023-01-24 22:43:22 +01:00
Markus Triska
af9f0f81d8 DOC: convert library(sgml) documentation to DocLog format 2023-01-24 22:42:58 +01:00
Markus Triska
1c08b56e05 strengthen reified division for divisor == 1 2023-01-24 22:15:05 +01:00
Markus Triska
6cb8020f62 DOC: add CLP(B) documentation in DocLog format 2023-01-24 22:15:05 +01:00
Markus Triska
d742d4cde9 DOC: convert library(time) documentation to DocLog format 2023-01-24 22:14:15 +01:00
Markus Triska
b7d06540e6 DOC: convert library(crypto) documentation to DocLog format 2023-01-24 22:13:38 +01:00
Markus Triska
909f2e1058 DOC: improve CLP(ℤ) DocLog documentation 2023-01-24 20:39:47 +01:00
Mark Thom
26d39c3617 Merge pull request #1695 from aarroyoc/website
Add website frontpage
2023-01-24 20:29:48 +01:00
Mark Thom
371bc3b231 Merge pull request #1676 from aarroyoc/docs-http-server
Compatible Doclog docs for library(http/http_server)
2023-01-24 04:09:39 +01:00
Adrián Arroyo Calle
bdeabcdd89 Website page 2023-01-23 23:51:27 +01:00
Adrián Arroyo Calle
7f177c3d03 Compatible Doclog docs for library(dcgs) 2023-01-23 21:03:11 +01:00
Mark Thom
4ed36a12e9 Merge branch 'retract_improvements' 2023-01-22 21:04:55 -07:00
Mark Thom
a7e93db363 improve retract/1 and related predicates (#1598) 2023-01-22 21:04:41 -07:00
Mark Thom
789715f31a Merge pull request #1693 from aarroyoc/docs-xpath
Compatible Doclog docs for library(xpath).
2023-01-23 04:04:00 +01:00
Mark Thom
7cc900d437 Merge pull request #1691 from aarroyoc/docs-os-3
Compatible Doclog docs for library(os)
2023-01-23 04:02:57 +01:00
Mark Thom
ff0f6f4fc2 Merge pull request #1690 from aarroyoc/docs-charsio
Compatible Doclog docs for library(charsio)
2023-01-23 04:02:02 +01:00
Mark Thom
5698e8f21a Merge pull request #1692 from aarroyoc/docs-between
Compatible Doclog docs for library(between).
2023-01-23 04:00:11 +01:00
Adrián Arroyo Calle
ddcae2c906 Compatible Doclog docs for library(xpath). 2023-01-22 21:22:54 +01:00
Adrián Arroyo Calle
468d096ccb Compatible Doclog docs for library(between). 2023-01-22 20:26:30 +01:00
Adrián Arroyo Calle
bca79d12c0 Compatible Doclog docs for library(os) 2023-01-22 17:45:50 +01:00
Adrián Arroyo Calle
03eba9594b Compatible Doclog docs for library(charsio) 2023-01-21 21:05:13 +01:00
Mark Thom
5e0e3e2754 Merge pull request #1687 from gruhn/master
Fix failing Docker build
2023-01-21 05:02:33 +01:00
Mark Thom
04fd835267 Merge pull request #1688 from aarroyoc/djot-migration
Migrate from Markdown to Djot
2023-01-21 04:48:26 +01:00
Adrián Arroyo Calle
f072761150 Fix assoc.pl file 2023-01-19 21:18:40 +01:00
Adrián Arroyo Calle
46d1e3bee3 Migrate from Markdown to Djot 2023-01-19 21:15:25 +01:00
Niklas Gruhn
f8e6e0252d Use lastest 1.xx Rust version in Docker build
With the previous Rust version 1.61, the build fails with

> error[E0658]: use of unstable library feature 'scoped_threads'

This has been "stabilized" in Rust 1.63. To avoid the hassle
of manually updating the version, we can just default to the
latest minor release.
2023-01-18 19:08:19 +01:00
Mark Thom
f9e3bdb6b0 restore free list usage on structures in facts without crashing lgtunit loader 2023-01-13 18:35:13 -07:00
Mark Thom
a80aab48cd Merge pull request #1677 from aarroyoc/docs-dif
Compatible Doclog docs for library(dif)
2023-01-13 07:50:17 +01:00
Mark Thom
3a4aa2a541 tighten deallocate truncation of stack (#1686) 2023-01-12 23:47:07 -07:00
Mark Thom
84583da5b8 Merge pull request #1685 from triska/reify_sign
ADDED: sign/1 is now reifiable.
2023-01-11 17:41:14 +01:00
Markus Triska
f213956ceb use (#)/1 2023-01-11 17:23:53 +01:00
Markus Triska
c5caa9d311 ADDED: sign/1 is now reifiable.
This addresses #1500.
2023-01-11 17:22:38 +01:00
Mark Thom
0c4d93f01f remove add_term_to_free_list from AddToList (#1684) 2023-01-10 18:24:48 -07:00
Mark Thom
a4e8bfc1ba Merge pull request #1682 from triska/reify_slash
FIXED: correctly reify (/)/2.
2023-01-10 23:44:48 +01:00
Markus Triska
542b9e1976 rely on newly available operator notation for (#)/1 2023-01-10 22:59:11 +01:00
Markus Triska
73a1ee59fa replace several more instances of ?/1 by (#)/1 2023-01-10 22:57:14 +01:00
Markus Triska
2771109427 use (#)/1 already internally for describing constraint projections 2023-01-10 22:50:38 +01:00
Markus Triska
cc420bd31a FIXED: reification of (xor)/2.
Example:

    ?- A #= 1 xor 0 #<==> R.
    %@    clpz:(A#=1#<==>R), clpz:(R in 0..1).
2023-01-10 22:09:41 +01:00
Markus Triska
2fe1d2ef53 FIXED: correctly reify (/)/2.
Example:

    ?- 0 #==> X #= 1/2.
    %@    clpz:(X in inf..sup)
    %@ ;  false.

This addresses #1501.
2023-01-10 17:35:43 +01:00
Mark Thom
bb624cc971 use free lists to allow register re-use (#1612) 2023-01-08 12:11:04 -07:00
Mark Thom
aa7b8e52f3 use '$enqueue_attr_var' when adding attributes only 2022-12-24 00:31:47 -07:00
Adrián Arroyo Calle
07f358c91b Compatible Doclog docs for library(dif) 2022-12-22 23:23:07 +01:00
Adrián Arroyo Calle
8ae0a1a4af Compatible Doclog docs for library(http/http_server) 2022-12-22 22:36:33 +01:00
Adrián Arroyo Calle
7647ad14b8 More feedback applied 2022-12-21 23:19:38 +01:00
Adrián Arroyo Calle
21e4347b3e Apply some feedback 2022-12-21 22:32:36 +01:00
Adrián Arroyo Calle
f2d041ea23 Merge branch 'master' into docs-builtins 2022-12-21 21:29:22 +01:00
Adrián Arroyo Calle
56c1c4e43c Compatible Doclog docs for builtins 2022-12-21 21:28:16 +01:00
Mark Thom
820011412b Merge pull request #1658 from aarroyoc/copy_file
Add predicate file_copy/2 in library(files)
2022-12-18 21:22:25 +01:00
Mark Thom
81afa6942f Merge pull request #1672 from triska/deref_register
dereference more registers, analogous to d660e4244f
2022-12-18 21:21:58 +01:00
Markus Triska
6cb8d7596a dereference more registers, analogous to d660e4244f
See also #1654 for a nice test case by @notoria which this corrects.
2022-12-18 17:43:33 +01:00
Mark Thom
a2d46af5ac Merge pull request #1671 from aarroyoc/docs-iso-ext
Compatible Doclog docs for library(iso_ext)
2022-12-18 00:38:22 +01:00
Mark Thom
6d94b8ab75 Merge pull request #1669 from aarroyoc/docs-http-open
Compatible Doclog docs for library(http/http_open).
2022-12-18 00:38:13 +01:00
Adrián Arroyo Calle
0166c3bf0f Compatible Doclog docs for library(iso_ext) 2022-12-17 22:46:44 +01:00
Adrián Arroyo Calle
6a995fb62b Compatible Doclog docs for library(http/http_open). 2022-12-17 20:43:43 +01:00
Mark Thom
d804d8a92e use proper dynamic arities in JmpByCall and JmpByExecute (#1605, #1606) 2022-12-17 11:54:20 -07:00
Mark Thom
cf63e8375d track attr_var_init lengths on the stack (#1667) 2022-12-16 20:10:17 -07:00
Mark Thom
1eff758751 update README to point to local wambook (#1668) 2022-12-16 00:45:00 -07:00
Mark Thom
0a8fc70ba9 detect cyclic bindings in attr_vars_of_term (#1666) 2022-12-16 00:42:38 -07:00
Mark Thom
b4b72a3166 Merge pull request #1662 from mthom/interpreting_disj
Fix mishandled if-then-else interpretation (#1659)
2022-12-16 04:36:02 +01:00
Mark Thom
a5054c0064 use append/3 rather than set_difference/3 to gather witnesses in bagof/3 and setof/3 (#1663, #1664) 2022-12-12 23:55:55 -07:00
Mark Thom
705f421d53 Merge pull request #1661 from aarroyoc/lcm2
Add predicate lcm/2 to library(arithmetic)
2022-12-12 00:38:40 +01:00
Mark Thom
4dc0114c52 fix mishandled if-then-else interpretation (#1659) 2022-12-11 16:35:32 -07:00
Adrián Arroyo Calle
5f2c77fa74 Add predicate lcm/2 to library(arithmetic) 2022-12-11 21:49:41 +01:00
Adrián Arroyo Calle
5f703afed1 Rename copy_file/2 to file_copy/2 2022-12-11 00:08:41 +01:00
Adrián Arroyo Calle
c6aa2068e2 Add predicate copy_file/2 in library(files) 2022-12-11 00:06:56 +01:00
Mark Thom
209f7a239a Merge pull request #1657 from aarroyoc/docs-files
Compatible Doclog docs for library(files)
2022-12-10 18:09:01 +01:00
Mark Thom
0d404ad374 Merge pull request #1656 from aarroyoc/docs-ordsets
Compatible Doclog docs for library(ordsets)
2022-12-10 18:08:45 +01:00
Mark Thom
d5db0c641c Merge pull request #1655 from triska/deref_register
more uses of newly available deref_register(n)
2022-12-10 18:08:26 +01:00
Adrián Arroyo Calle
21d6220f3f Compatible Doclog docs for library(files) 2022-12-08 23:41:28 +01:00
Adrián Arroyo Calle
e0464d5447 Compatible Doclog docs for library(ordsets) 2022-12-08 22:30:48 +01:00
Markus Triska
309e5b320e more uses of newly available deref_register(n) 2022-12-07 23:19:31 +01:00
Mark Thom
afa9703eb5 Merge pull request #1653 from triska/deref_register
introduce and use deref_register(n)
2022-12-07 05:52:07 +01:00
Markus Triska
56e5da6680 introduce and use deref_register(n) 2022-12-06 21:07:50 +01:00
Mark Thom
a8810d73e4 Merge pull request #1652 from aarroyoc/docs-lists
Compatible Doclog docs for library(lists)
2022-12-06 17:57:46 +01:00
Mark Thom
4b31c30cab Merge pull request #1651 from aarroyoc/docs-sockets
Compatible Doclog docs for library(sockets)
2022-12-06 17:57:36 +01:00
Adrián Arroyo Calle
df4b56148f Compatible Doclog docs for library(lists) 2022-12-06 13:19:10 +01:00
Adrián Arroyo Calle
f22a48f576 Compatible Doclog docs for library(sockets) 2022-12-06 11:58:26 +01:00
Mark Thom
d660e4244f dereference encoding register in crypto_data_decrypt (#1650) 2022-12-05 23:28:47 -07:00
Mark Thom
d383e5eb8b avoid pushing stack variables to the heap in get_continuation_chunk (#1644) 2022-12-05 23:17:15 -07:00
Mark Thom
e1dc114517 Merge pull request #1649 from aarroyoc/docs-ugraphs
Compatible Doclog docs for library(ugraphs)
2022-12-05 06:05:13 +01:00
Mark Thom
73780ebf63 Merge pull request #1648 from aarroyoc/docs-random
Compatible Doclog docs for library(random)
2022-12-05 06:05:02 +01:00
Mark Thom
a19f7a0b9f Merge pull request #1647 from aarroyoc/docs-uuid
Compatible Doclog docs for library(uuid)
2022-12-05 06:04:48 +01:00
Mark Thom
e07473d155 Merge pull request #1646 from aarroyoc/docs-assoc
Compatible Doclog docs for library(assoc)
2022-12-05 06:04:30 +01:00
Adrián Arroyo Calle
d429b263eb Compatible Doclog docs for library(ugraphs) 2022-12-05 00:09:32 +01:00
Adrián Arroyo Calle
b2a0d0c1c7 Compatible Doclog docs for library(random) 2022-12-02 23:43:24 +01:00
Adrián Arroyo Calle
8bafd7adb1 Compatible Doclog docs for library(uuid) 2022-12-02 23:23:16 +01:00
Adrián Arroyo Calle
76d24fe4e3 Compatible Doclog docs for library(assoc) 2022-12-02 23:05:03 +01:00
Mark Thom
3bdcc3aba9 return -1 from get_code to indicate end of file (#1622) 2022-11-18 18:19:55 -07:00
Mark Thom
cb25b27963 Merge pull request #1640 from gruhn/master
Adjust Github Action: Docker Publish
2022-11-16 20:57:35 +01:00
Niklas Gruhn
b3df81c143 Adjust Github Action: Docker Publish
1. Not only publish Docker images when new release tags are created but
   on every push to master, since release frequency is so low.

2. Use newer versions of the various actions (setup-buildx-action,
   login-action, metadata-action, ...) to suppress some deprecation
   warnings see:
   https://github.blog/changelog/2022-10-11-github-actions-deprecating-save-state-and-set-output-commands/
2022-11-15 18:55:15 +01:00
Mark Thom
68b3c480c9 update Dockerfile to use rustc 1.61 2022-11-14 21:18:03 -07:00
Mark Thom
9fd1bf5574 mention #scryer in README 2022-11-14 21:16:46 -07:00
Mark Thom
b491a06c6d README rustc version bump 2022-11-14 21:13:52 -07:00
Mark Thom
d16312a314 use existing bindings in compile_is (#1545) 2022-11-14 20:58:07 -07:00
Mark Thom
d19a8d6b98 begin to mark registers as safe from built-in predicates like is/2 (#1545) 2022-11-14 20:58:07 -07:00
Mark Thom
c90dd80ece revise UnsafeVarMarker (#1545) 2022-11-14 20:57:51 -07:00
Paulo Moura
495025dafb Add support for the float_integer_part/1 and float_fractional_part/1 standard arithmetic functions 2021-10-24 09:10:38 +01:00
132 changed files with 32917 additions and 19321 deletions

179
.github/workflows/ci.yml vendored Normal file
View File

@@ -0,0 +1,179 @@
name: CI
on:
push:
branches: [master]
tags:
- "v**"
pull_request:
schedule:
- cron: '0 0 * * 3' # At 12:00 AM, only on Wednesday
workflow_dispatch:
jobs:
build-test:
runs-on: ${{ matrix.os }}
strategy:
fail-fast: false
matrix:
include:
# operating systems
- { os: windows-latest, rust-version: stable, publish: true, target: 'x86_64-pc-windows-msvc'}
- { os: macos-11, rust-version: stable, publish: true, target: 'x86_64-apple-darwin' }
- { os: ubuntu-20.04, rust-version: stable, publish: true, target: 'x86_64-unknown-linux-gnu' }
# architectures
- { os: ubuntu-22.04, rust-version: stable, publish: true, target: 'x86_64-unknown-linux-gnu', extra: true }
- { os: ubuntu-22.04, rust-version: stable, publish: true, target: 'i686-unknown-linux-gnu' }
- { os: ubuntu-22.04, rust-version: nightly, publish: true, target: 'wasm32-unknown-unknown', args: '--no-default-features' }
# rust versions
- { os: ubuntu-22.04, rust-version: "1.70", target: 'x86_64-unknown-linux-gnu'}
- { os: ubuntu-22.04, rust-version: beta, target: 'x86_64-unknown-linux-gnu'}
- { os: ubuntu-22.04, rust-version: nightly, target: 'x86_64-unknown-linux-gnu'}
defaults:
run:
shell: bash
steps:
- uses: actions/checkout@v3
- uses: dtolnay/rust-toolchain@master
id: toolchain
with:
toolchain: ${{ matrix.rust-version }}
targets: ${{ matrix.target }}
components: clippy, rustfmt
- name: Install i686 dependencies
if: "contains(matrix.target,'i686')"
run: |
sudo dpkg --add-architecture i386
sudo apt-get update
sudo apt-get install libssl-dev:i386 gcc-multilib clang -y
echo "CC=clang" >> $GITHUB_ENV
echo "PKG_CONFIG_SYSROOT_DIR=/" >> $GITHUB_ENV
- uses: actions/cache@v3
with:
path: |
~/.cargo/bin/
~/.cargo/registry/index/
~/.cargo/registry/cache/
~/.cargo/git/db/
target/
key: ${{ matrix.os }}_${{ matrix.target }}_rustc-${{ steps.toolchain.outputs.cachekey }}_cargo-${{ hashFiles('**/Cargo.lock') }}
# Build and test.
- name: Build library
run: cargo rustc --lib --target ${{ matrix.target }} ${{ matrix.args }} --verbose
- name: Test
if: "!matrix.extra"
run: cargo test --target ${{ matrix.target }} ${{ matrix.args }} --all --verbose || echo "::warning ::Tests failed"
# Extra steps only run once to avoid duplication, when matrix.extra is true
- name: Test and report
if: matrix.extra
run: |
cargo install cargo2junit --force
RUSTC_BOOTSTRAP=1 cargo test --all -- -Z unstable-options --format json --report-time | cargo2junit > cargo_test_results.xml
- name: Publish cargo test results artifact
if: matrix.extra
uses: actions/upload-artifact@v3
with:
name: cargo-test-results
path: cargo_test_results.xml
- name: Publish cargo test summary
if: matrix.extra
uses: EnricoMi/publish-unit-test-result-action/composite@master
with:
check_name: Cargo test summary
files: cargo_test_results.xml
fail_on: nothing
comment_mode: off
- name: Check formatting
if: matrix.extra
run: cargo fmt --check || echo "::warning ::cargo fmt found some formatting changes that may improve readability"
- name: Check clippy
if: matrix.extra
run: cargo clippy --no-deps || echo "::warning ::cargo clippy found some code style changes that may be more idiomatic"
# On stable rust builds, build a binary and publish as a github actions
# artifact. These binaries could be useful for testing the pipeline but
# are only retained by github for 90 days.
- name: Build release binary
if: matrix.publish
run: |
cargo rustc --target ${{ matrix.target }} ${{ matrix.args }} --verbose --bin scryer-prolog --release
echo "$PWD/target/release" >> $GITHUB_PATH
- name: Publish release binary artifact
if: matrix.publish
uses: actions/upload-artifact@v3
with:
path: target/${{ matrix.target }}/release/scryer-prolog*
name: scryer-prolog_${{ matrix.os }}_${{ matrix.target }}
logtalk-test:
# if: false # uncomment to disable job
runs-on: ubuntu-20.04
needs: [build-test]
steps:
# Download prebuilt ubuntu binary from build-test job, setup logtalk
- uses: actions/download-artifact@v3
with:
name: scryer-prolog_ubuntu-20.04_x86_64-unknown-linux-gnu
- run: |
chmod +x scryer-prolog
echo "$PWD" >> "$GITHUB_PATH"
- name: Install Logtalk
uses: logtalk-actions/setup-logtalk@master
with:
logtalk-version: "3.70.0"
logtalk-tool-dependencies: false
# Run logtalk tests.
- name: Run Logtalk's prolog compliance test suite
working-directory: ${{ env.LOGTALKUSER }}/tests/prolog/
run: |
pwd
scryerlgt -g '{ack(tester)},halt.'
logtalk_tester -p scryer -g "set_logtalk_flag(clean,off)" -w -t 360 \
-f xunit \
-s "$LOGTALKUSER/tests/prolog" \
|| echo "::warning ::logtalk compliance suite failed"
# -u "https://github.com/LogtalkDotOrg/logtalk3/tree/$LOGTALK_GIT_HASH/tests/prolog/" \
- name: Publish Logtalk test logs
uses: actions/upload-artifact@v3
with:
name: logtalk-test-logs
path: '${{ env.LOGTALKUSER }}/tests/prolog/logtalk_tester_logs'
- name: Publish Logtalk test results artifact
uses: actions/upload-artifact@v3
with:
name: logtalk-test-results
path: '${{ env.LOGTALKUSER }}/tests/prolog/**/*.xml'
- name: Publish Logtalk test summary
uses: EnricoMi/publish-unit-test-result-action/composite@master
with:
check_name: Logtalk test summary
files: '${{ env.LOGTALKUSER }}/tests/prolog/**/*.xml'
fail_on: nothing
comment_mode: off
# Publish binaries when building for a tag
release:
runs-on: ubuntu-20.04
needs: [build-test]
if: startsWith(github.ref, 'refs/tags/v')
steps:
- uses: actions/download-artifact@v3
- name: Zip binaries for release
run: |
zip scryer-prolog_macos-11.zip ./scryer-prolog_macos-11_x86_64-apple-darwin/scryer-prolog
zip scryer-prolog_ubuntu-20.04.zip ./scryer-prolog_ubuntu-20.04_x86_64-unknown-linux-gnu/scryer-prolog
zip scryer-prolog_ubuntu-22.04.zip ./scryer-prolog_ubuntu-22.04_x86_64-unknown-linux-gnu/scryer-prolog
zip scryer-prolog_windows-latest.zip ./scryer-prolog_windows-latest_x86_64-pc-windows-msvc/scryer-prolog.exe
zip scryer-prolog_wasm32.zip ./scryer-prolog_ubuntu-22.04_wasm32-unknown-unknown/scryer-prolog.wasm
- name: Release
uses: softprops/action-gh-release@v1
with:
files: |
scryer-prolog_macos-11.zip
scryer-prolog_ubuntu-20.04.zip
scryer-prolog_ubuntu-22.04.zip
scryer-prolog_windows-latest.zip
scryer-prolog_wasm32.zip

View File

@@ -2,10 +2,10 @@ name: Docker Publish
on:
push:
tags: [ 'v*.*.*' ]
env:
IMAGE_NAME: mjt128/scryer-prolog
branches:
- 'master'
tags:
- 'v*.*.*'
jobs:
build:
@@ -18,33 +18,36 @@ jobs:
# Workaround: https://github.com/docker/build-push-action/issues/461
- name: Setup Docker buildx
uses: docker/setup-buildx-action@79abd3f86f79a9d68a23c75a09a9a85889262adf
# https://github.com/docker/setup-buildx-action
uses: docker/setup-buildx-action@v2.2.1
# Login against Docker registry
# https://github.com/docker/login-action
- name: Log into registry
uses: docker/login-action@28218f9b04b4f3f62068d7b6ce6ca5b26e35336c
# https://github.com/docker/login-action
uses: docker/login-action@v2.1.0
with:
username: ${{ secrets.DOCKERHUB_USERNAME }}
password: ${{ secrets.DOCKERHUB_TOKEN }}
# Extract Docker image tag from git tag. E.g. if git tag is "v0.19.1" then use
# Docker image tag "0.19.1". Tag "latest" is automatically synced with newest
# version.
# https://github.com/docker/metadata-action
# Docker image tag "0.19.1". The "latest" tag reflects the most recent build on
# master.
- name: Extract Docker metadata
id: meta
uses: docker/metadata-action@98669ae865ea3cffbcbaa878cf57c20bbf1c6c38
# https://github.com/docker/metadata-action
uses: docker/metadata-action@v4.1.1
with:
images: docker.io/${{ env.IMAGE_NAME }}
images: docker.io/${{ secrets.DOCKERHUB_USERNAME }}/scryer-prolog
tags: |
type=semver,pattern={{version}}
type=raw,value=latest,enable={{is_default_branch}}
# type=raw,value=latest,enable=${{ github.ref == format('refs/heads/{0}', 'master') }}
# Build and push Docker image with Buildx
# https://github.com/docker/build-push-action
- name: Build and push Docker image
id: build-and-push
uses: docker/build-push-action@ad44023a93711e3deb337508980b4b5e9bcdc5dc
# https://github.com/docker/build-push-action
uses: docker/build-push-action@v3.2.0
with:
context: .
push: true

View File

@@ -1,71 +0,0 @@
name: Test
on: [push, pull_request]
jobs:
build:
runs-on: ${{ matrix.os }}
strategy:
matrix:
os: [ubuntu-20.04, macos-10.15]
rust-version: [stable, beta]
steps:
- name: Checkout sources
uses: actions/checkout@v2
- name: Install Rust
uses: actions-rs/toolchain@v1
with:
profile: minimal
toolchain: ${{ matrix.rust-version }}
override: true
- name: Build lib
uses: actions-rs/cargo@v1
with:
command: rustc
args: --verbose --lib -- -D warnings
- name: Build bin
uses: actions-rs/cargo@v1
with:
command: rustc
args: --verbose --bin scryer-prolog -- -D warnings
- name: Test
uses: actions-rs/cargo@v1
with:
command: test
args: --verbose --all
- name: Num tests
uses: actions-rs/cargo@v1
continue-on-error: true
with:
command: test
args: --verbose --all --no-default-features --features num
msrv:
runs-on: ${{ matrix.os }}
strategy:
matrix:
os: [ubuntu-20.04, macos-10.15]
steps:
- name: Checkout sources
uses: actions/checkout@v2
- name: Install cargo-msrv
uses: baptiste0928/cargo-install@v1.1.0
with:
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

1954
Cargo.lock generated

File diff suppressed because it is too large Load Diff

View File

@@ -1,6 +1,6 @@
[package]
name = "scryer-prolog"
version = "0.9.1"
version = "0.9.3"
authors = ["Mark Thom <markjordanthom@gmail.com>"]
edition = "2021"
description = "A modern Prolog implementation written mostly in Rust."
@@ -10,10 +10,20 @@ license = "BSD-3-Clause"
keywords = ["prolog", "prolog-interpreter", "prolog-system"]
categories = ["command-line-utilities"]
build = "build/main.rs"
rust-version = "1.61"
rust-version = "1.70"
[lib]
crate-type = ["cdylib", "rlib"]
[features]
default = ["rug"]
default = ["ffi", "repl", "hostname", "tls", "http", "crypto-full"]
ffi = ["dep:libffi"]
repl = ["dep:crossterm", "dep:ctrlc", "dep:rustyline"]
hostname = ["dep:hostname"]
tls = ["dep:native-tls"]
http = ["dep:warp", "dep:reqwest"]
rust_beta_channel = []
crypto-full = []
[build-dependencies]
indexmap = "1.0.2"
@@ -21,56 +31,85 @@ proc-macro2 = "1.0.36"
quote = "1.0.15"
strum = "0.23"
strum_macros = "0.23"
syn = { version = "1.0.88", features = ['full', 'visit', 'extra-traits'] }
to-syn-value = "0.1.0"
to-syn-value_derive = "0.1.0"
syn = { version = "2.0.32", features = ['full', 'visit', 'extra-traits'] }
to-syn-value = "0.1.1"
to-syn-value_derive = "0.1.1"
walkdir = "2"
[dependencies]
bit-set = "0.5.3"
bitvec = "1"
cpu-time = "1.0.0"
crossterm = "0.20.0"
dirs-next = "2.0.0"
divrem = "0.1.0"
fxhash = "0.2.1"
git-version = "0.3.4"
hostname = "0.3.1"
indexmap = "1.0.2"
lazy_static = "1.4.0"
lexical = "5.2.2"
libc = "0.2.62"
modular-bitfield = "0.11.2"
ctrlc = "3.2.2"
ordered-float = "2.6.0"
phf = { version = "0.9", features = ["macros"] }
phf = { version = "0.9", features = ["macros"] }
ref_thread_local = "0.0.0"
rug = { version = "1.15.0", optional = true }
rustyline = "9.0.0"
ring = "0.16.13"
ripemd160 = "0.8.0"
sha3 = "0.8.2"
blake2 = "0.8.1"
crrl ="0.2.0"
native-tls = "0.2.4"
crrl = "0.6.0"
chrono = "0.4.11"
select = "0.4.3"
select = "0.6.0"
roxmltree = "0.11.0"
base64 = "0.12.3"
smallvec = "1.8.0"
sodiumoxide = "0.2.6"
static_assertions = "1.1.0"
ryu = "1.0.9"
hyper = { version = "0.14", features = ["full"] }
hyper-tls = "0.5.0"
tokio = { version = "1", features = ["full"] }
futures = "0.3"
regex = "1.9.1"
libloading = "0.7"
derive_deref = "1.1.1"
bytes = "1"
dashu = "0.4.0"
num-order = { version = "1.2.0" }
rand = "0.8.5"
[target.'cfg(not(target_arch = "wasm32"))'.dependencies]
libffi = { version = "3.2.0", optional = true }
hostname = { version = "0.3.1", optional = true }
crossterm = { version = "0.20.0", optional = true }
ctrlc = { version = "3.2.2", optional = true }
rustyline = { version = "12.0.0", optional = true }
native-tls = { version = "0.2.4", optional = true }
warp = { version = "=0.3.5", features = ["tls"], optional = true }
reqwest = { version = "0.11.18", features = ["blocking"], optional = true }
tokio = { version = "1.28.2", features = ["full"] }
[target.'cfg(target_arch = "wasm32")'.dependencies]
getrandom = { version = "0.2.10", features = ["js"] }
tokio = { version = "1.28.2", features = ["sync", "macros", "io-util", "rt", "time"] }
[target.'cfg(all(target_arch = "wasm32", target_os = "unknown"))'.dependencies]
console_error_panic_hook = "0.1"
console_log = "1.0"
wasm-bindgen = "0.2.87"
wasm-bindgen-futures = "0.4"
serde-wasm-bindgen = "0.5"
web-sys = { version = "0.3", features = [
"Document",
"Window",
"Element",
]}
[target.'cfg(target_os = "wasi")'.dependencies]
ring-wasi = { version = "0.16.25" }
[target.'cfg(not(target_os = "wasi"))'.dependencies]
ring = { version = "0.16.13" }
[dev-dependencies]
assert_cmd = "1.0.3"
predicates-core = "1.0.2"
serial_test = "0.5.1"
maplit = "1.0.2"
serial_test = "2.0.0"
[patch.crates-io]
modular-bitfield = { git = "https://github.com/mthom/modular-bitfield" }
[profile.release]
debug = true
modular-bitfield = { git = "https://github.com/mthom/modular-bitfield" }

View File

@@ -1,5 +1,5 @@
# See https://github.com/LukeMathWalker/cargo-chef
ARG RUST_VERSION=1.60-buster
ARG RUST_VERSION=1-buster
FROM rust:${RUST_VERSION} as planner
WORKDIR /scryer-prolog
RUN cargo install cargo-chef
@@ -20,7 +20,12 @@ COPY --from=cacher /scryer-prolog/target target
COPY --from=cacher $CARGO_HOME $CARGO_HOME
RUN cargo build --release --bin scryer-prolog
FROM debian:stable-slim
# Newer versions of Debian (i.e. bookworm) contain libssl3 instead of libssl1.1
# which we depend on.
FROM debian:bullseye-slim
COPY --from=builder /scryer-prolog/target/release/scryer-prolog /usr/local/bin
ENV RUST_BACKTRACE=1
# Sanity check the binary: if it can't be executed (e.g. if there are missing libraries)
# then fail the build
RUN scryer-prolog --version
ENTRYPOINT ["/usr/local/bin/scryer-prolog"]

83
INDEX.dj Normal file
View File

@@ -0,0 +1,83 @@
# Scryer Prolog
```
?- append("Hello, ", X, "Hello, Scryer Prolog!").
X = "Scryer Prolog!".
```
``` =html
<div style="border: solid #00007f 3px;padding-left: 15px;padding-right: 15px;font-style: italic;background-color: #00007f30;">
<h4>Scryer Prolog Meetup 2023</h4>
<p>The first annual Scryer Prolog meetup is going to happen in Düsseldorf (Germany) on the 9th and 10th of November 2023. Join us to discover the present and future of Scryer Prolog! Participation is free, registration not required. <a href="https://hsd-pbsa.de/veranstaltung/scryer-prolog-meetup-2023/">More details here.</a></p>
</div>
```
![scryer](scryer.png){width=128 style=float:right;} [Scryer Prolog](https://github.com/mthom/scryer-prolog) is a free software ISO Prolog system intended to be an industrial
strength production environment *and* a testbed for bleeding edge research in
logic and constraint programming.
Some of the Scryer Prolog features are:
* ISO standard compliant
* Integrated constraint programming libraries: [clp(B)](/clpb.html), [clp(Z)](/clpz.html).
* [Definite Clause Grammars](/dcgs.html)
* Coroutining support ([`dif/2`](/dif.html), [`freeze/2`](/freeze.html), ...)
* [Tabling and SLG resolution](/tabling.html)
* Compact string representation
* Network libraries ([TCP sockets](/sockets.html), [HTTP server](/http/http_server.html), [HTTP client](/http/http_open.html), ...)
* [Cryptographical predicates](/crypto.html)
* [Foreign Function Interface](/ffi.html)
* WebAssembly support
* WAM based engine, cross-platform made in Rust
* _and more..._
Try Scryer Prolog without any installation! Use [Scryer Playground](https://play.scryer.pl), which uses the WASM version of Scryer Prolog.
## What is Prolog?
Prolog is a logic programming language created by [Alain Colmerauer](https://en.wikipedia.org/wiki/Alain_Colmerauer) and [Robert Kowalski](https://en.wikipedia.org/wiki/Robert_Kowalski) in 1972.
The idea behind Prolog is try to express a task in language similar to First Order Logic.
Prolog systems include _unification_ and _non-determinism_ as key concepts upon which we build programs.
A Prolog program is made up of predicates which define a relation between its arguments. A predicate
is made from clauses. A clause can be either a fact or a rule. There's also a toplevel, which we
can use to ask and reason about our task.
It's still to this day one of the best examples and one of the most popular languages in the field
of logic programming. That's because Prolog allows us to elegantly solve many tasks with short and
general programs.
If you want a more detailed description of Prolog, check [A Tour of Prolog](https://www.youtube.com/watch?v=8XUutFBbUrg).
If you want to learn more about Prolog history, check the videos [l'Aventure Prolog](https://www.youtube.com/watch?v=74Ig_QKndvE) and [50 years of Prolog and beyond](https://prologyear.logicprogramming.org/videos/PrologDay_Session_1_talk.mp4).
## Where can I learn Prolog?
There are a lot of classical Prolog books. Those books can teach you the basics of Prolog. Some
examples are: _The Art of Prolog (Shapiro)_, _Programming in Prolog (Clocksin, Mellish)_ and _The Craft
of Prolog (O'Keefe)_. However, most of them are not updated to _modern_ Prolog.
We recommend _[The Power of Prolog (Markus Triska)](https://www.metalevel.at/prolog)_ for modern Prolog. For reference about
the builtin Prolog modules and libraries in Scryer, check the documentation site. It's this!
## Downloads
The latest version of Scryer Prolog is *0.9.2*. And it's already useful for lots of tasks.
| Windows | [Download](https://github.com/mthom/scryer-prolog/releases/download/v0.9.2/scryer-prolog_windows-latest.zip) |
| macOS (Intel) | [Download](https://github.com/mthom/scryer-prolog/releases/download/v0.9.2/scryer-prolog_macos-11.zip) |
| Linux | [Download](https://github.com/mthom/scryer-prolog/releases/download/v0.9.2/scryer-prolog_ubuntu-20.04.zip) |
Scryer Prolog can also be compiled from source, instructions are on the [GitHub README](https://github.com/mthom/scryer-prolog). It runs on Linux, macOS and Windows. Other operating systems may work but they're not regularly tested.
If you're in Linux, maybe your distribution already has an Scryer Prolog package.
There's also a [Docker image](https://github.com/mthom/scryer-prolog#docker-install) available.
## Support and discussions
If Scryer Prolog crashes or yields unexpected errors, consider filing
an [issue](https://github.com/mthom/scryer-prolog/issues).
To get in touch with the Scryer Prolog community, participate in
[discussions](https://github.com/mthom/scryer-prolog/discussions)
or visit our #scryer IRC channel on [Libera](https://libera.chat)!

163
README.md
View File

@@ -6,14 +6,17 @@ source industrial strength production environment that is also a
testbed for bleeding edge research in logic and constraint
programming, which is itself written in a high-level language.
As of July 2023, **Scryer Prolog passes all [syntactic conformity&nbsp;tests](https://www.complang.tuwien.ac.at/ulrich/iso-prolog/conformity_testing)**.
The homepage of the project is: [**https://www.scryer.pl**](https://www.scryer.pl)
![Scryer Logo: Cryer](logo/scryer.png)
## Phase 1
Produce an implementation of the Warren Abstract Machine in Rust, done
according to the progression of languages in [Warren's Abstract
Machine: A Tutorial
Reconstruction](http://wambook.sourceforge.net/wambook.pdf).
Machine: A Tutorial Reconstruction](https://github.com/mthom/scryer-prolog/blob/master/wambook/wambook.pdf).
Phase 1 has been completed in that Scryer Prolog implements in some form
all of the WAM book, including lists, cuts, Debray allocation, first
@@ -44,7 +47,7 @@ Extend Scryer Prolog to include the following, among other features:
- [x] Support for `attribute_goals/2` and `project_attributes/2`
- [x] `call_residue_vars/2`
- [x] `if_/3` and related predicates, following the developments of the
paper "Indexing `dif/2`".
paper "[Indexing `dif/2`](https://arxiv.org/abs/1607.01590)".
- [x] All-solutions predicates (`findall/{3,4}`, `bagof/3`, `setof/3`, `forall/2`).
- [x] Clause creation and destruction (`asserta/1`, `assertz/1`,
`retract/1`, `abolish/1`) with logical update semantics.
@@ -52,24 +55,24 @@ Extend Scryer Prolog to include the following, among other features:
`bb_put/2` (non-backtrackable) and `bb_b_put/2`
(backtrackable).
- [x] Delimited continuations based on reset/3, shift/1 (documented in
"Delimited Continuations for Prolog").
"[Delimited Continuations for Prolog](https://biblio.ugent.be/publication/5646080/file/5646081)").
- [x] Tabling library based on delimited continuations
(documented in "Tabling as a Library with Delimited Control").
(documented in "[Tabling as a Library with Delimited Control](https://biblio.ugent.be/publication/6880648/file/6885145.pdf)").
- [x] A _redone_ representation of strings as difference lists of
characters, using a packed internal representation.
- [x] clp(B) and clp() as builtin libraries.
- [x] Streams and predicates for stream control.
- [x] A simple sockets library representing TCP connections as streams.
- [x] A simple sockets library representing TCP connections as streams.
- [x] Incremental compilation and loading process, newly written,
primarily in Prolog.
- [ ] Improvements to the WAM compiler and heap representation:
- [ ] Replacing choice points pivoting on inlined semi-deterministic predicates
(`atom`, `var`, etc) with if/else ladders. (_in progress_)
- [ ] Inlining all built-ins and system call instructions.
- [ ] Greatly reducing the number of instructions used to compile disjunctives.
- [x] Greatly reducing the number of instructions used to compile disjunctives.
- [ ] Storing short atoms to heap cells without writing them to the atom table.
- [ ] A compacting garbage collector satisfying the five properties of
"Precise Garbage Collection in Prolog." (_in progress_)
"[Precise Garbage Collection in Prolog](https://www.complang.tuwien.ac.at/ulrich/papers/PDF/2008-ciclops.pdf)." (_in progress_)
- [ ] Mode declarations.
## Phase 3
@@ -88,12 +91,12 @@ nice to have in the future. They'd make a good project for anyone wanting
to contribute code to Scryer Prolog.
1. Implement the global analysis techniques described in Peter van
Roy's thesis, "Can Logic Programming Execute as Fast as Imperative
Programming?"
Roy's thesis, "[Can Logic Programming Execute as Fast as Imperative
Programming?](https://www.info.ucl.ac.be/~pvr/Peter.thesis/Peter.thesis.html)"
2. Add unum representation and arithmetic, using either an existing
unum implementation or an ad hoc one. Unums are described in
Gustafson's book "The End of Error."
Gustafson's book "[The End of Error](http://www.johngustafson.net/unums.html)."
3. Add concurrent tables to manage shared references to atoms and
strings.
@@ -102,7 +105,14 @@ strings.
## Installing Scryer Prolog
### Native Install
### Binaries
Precompiled binaries for several platforms are available for download
at:
**https://github.com/mthom/scryer-prolog/releases/tag/v0.9.2**
### Native Compilation
First, install the latest stable version of
[Rust](https://www.rust-lang.org/en-US/install.html) using your
@@ -114,19 +124,23 @@ distribution should be uninstalled from your system before rustup is
used.
Currently the only way to install the latest version of Scryer is to
clone directly from this git repository, which can be done as follows:
clone directly from this git repository, and compile the system. This
can be done as follows:
```
$> git clone https://github.com/mthom/scryer-prolog
$> cd scryer-prolog
$> cargo run [--release]
$> cargo build --release
```
The optional `--release` flag will perform various optimizations,
producing a faster executable.
The `--release` flag performs various optimizations, producing a
faster executable.
After compilation, the executable `scryer-prolog` is available in the
directory&nbsp;`target/release` and can be invoked to run the system.
On Windows, Scryer Prolog is easier to build inside a [MSYS2](https://www.msys2.org/)
environment as some crates may require native C compilation. However,
environment as some crates may require native C compilation. However,
the resulting binary does not need MSYS2 to run. When executing Scryer in a shell, it is recommended to use a more advanced shell than mintty (the default MSYS2 shell). The [Windows Terminal](https://github.com/microsoft/terminal) works correctly.
To build a Windows Installer, you'll need first Scryer Prolog compiled in release mode, then, with WiX Toolset installed, execute:
@@ -136,7 +150,78 @@ light.exe scryer-prolog.wixobj
```
It will generate a very basic MSI file which installs the main executable and a shortcut in the Start Menu. It can be installed with a double-click. To uninstall, go to the Control Panel and uninstall as usual.
Scryer Prolog must be built with **Rust 1.57 and up**.
Scryer Prolog must be built with **Rust 1.70 and up**.
### Building WebAssembly
Scryer Prolog has basic WebAssembly support. You can follow `wasm-pack`'s [official instructions](https://rustwasm.github.io/docs/wasm-pack/quickstart.html) to install `wasm-pack` and build it in any way you like.
However, none of the [default features](https://doc.rust-lang.org/cargo/reference/features.html#the-default-feature) are currently supported. The preferred way of disabling them is passing [extra options](https://rustwasm.github.io/wasm-pack/book/commands/build.html#extra-options) to `wasm-pack`.
For example, if you want a minimal working package without using any bundler like `webpack`, you can do this:
```
wasm-pack build --target web -- --no-default-features
```
Then a `pkg` directory will be created, containing everything you need for a webapp. You can test whether the package is successfully built by creating an html file, adapted from `wasm-bindgen`'s [official example](https://rustwasm.github.io/wasm-bindgen/examples/without-a-bundler.html) like this:
```html
<!DOCTYPE html>
<html>
<head>
<meta charset="UTF-8" />
<title>Scryer Prolog - Sudoku Solver Example</title>
<script type="module">
import init, { eval_code } from './pkg/scryer_prolog.js';
const run = async () => {
await init("./pkg/scryer_prolog_bg.wasm");
let code = `
:- use_module(library(format)).
:- use_module(library(clpz)).
:- use_module(library(lists)).
sudoku(Rows) :-
length(Rows, 9), maplist(same_length(Rows), Rows),
append(Rows, Vs), Vs ins 1..9,
maplist(all_distinct, Rows),
transpose(Rows, Columns),
maplist(all_distinct, Columns),
Rows = [As,Bs,Cs,Ds,Es,Fs,Gs,Hs,Is],
blocks(As, Bs, Cs),
blocks(Ds, Es, Fs),
blocks(Gs, Hs, Is).
blocks([], [], []).
blocks([N1,N2,N3|Ns1], [N4,N5,N6|Ns2], [N7,N8,N9|Ns3]) :-
all_distinct([N1,N2,N3,N4,N5,N6,N7,N8,N9]),
blocks(Ns1, Ns2, Ns3).
problem(1, [[_,_,_,_,_,_,_,_,_],
[_,_,_,_,_,3,_,8,5],
[_,_,1,_,2,_,_,_,_],
[_,_,_,5,_,7,_,_,_],
[_,_,4,_,_,_,1,_,_],
[_,9,_,_,_,_,_,_,_],
[5,_,_,_,_,_,_,7,3],
[_,_,2,_,1,_,_,_,_],
[_,_,_,_,4,_,_,_,9]]).
main :-
problem(1, Rows), sudoku(Rows), maplist(portray_clause, Rows).
:- initialization(main).
`;
const result = eval_code(code);
document.write(`<p>Sudoku solver returns:</p><pre>${result}</pre>`);
}
run();
</script>
</head>
<body></body>
</html>
```
Then you can serve it with your favorite http server like `python -m http.server` or `npx serve`, and access the page with your browser.
### Docker Install
@@ -278,14 +363,14 @@ innovations of Scryer Prolog. This means that terms which appear as
lists of characters to Prolog programs are stored in packed
UTF-8&nbsp;encoding by the engine.
Without this innovation, storing a list of characters in memory
would use one memory&nbsp;cell per character, one memory&nbsp;cell per
list constructor, and one memory&nbsp;cell for each tail that occurs
in the list. Since one memory&nbsp;cell takes 8&nbsp;bytes on 64-bit
machines, the packed representation used by Scryer&nbsp;Prolog yields
an up&nbsp;to **24-fold&nbsp;reduction** of memory usage, and
corresponding reduction of memory&nbsp;accesses when creating and
processing strings.
Without this innovation, storing a list of characters in memory would
use one WAM memory&nbsp;cell per character, one cell per list
constructor, and one cell for each tail that occurs in the list. Since
one cell takes 8&nbsp;bytes in the WAM as implemented by
Scryer&nbsp;Prolog, the packed representation yields an up&nbsp;to
**24-fold&nbsp;reduction** of memory usage, and corresponding
reduction of memory&nbsp;accesses when creating and processing
strings.
Scryer Prolog's compact internal string representation makes it
ideally suited for the use case Prolog was originally developed for:
@@ -539,7 +624,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.1 and HTTP/2.0 web server. Uses [Hyper](https://hyper.rs) as a backend. Supports some query and form handling.
* [`http/http_server`](src/lib/http/http_server.pl) Runs a HTTP/1.1 and HTTP/2.0 web server. Uses [Warp](https://github.com/seanmonstar/warp) 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
@@ -673,10 +758,32 @@ not need additional tools and formalisms for its application, and
further, it encourages declarative reasoning that can in principle
also be performed automatically.
## Applications
Scryer Prolog's strong commitment to the Prolog ISO standard makes it
ideally suited for use in corporations and government&nbsp;agencies
that are subject to strict regulations pertaining to interoperability,
standards&nbsp;compliance and warranty.
Successful existing applications of Scryer Prolog include the
[DocLog](https://github.com/aarroyoc/doclog)&nbsp;system which
generates Scryer's own documentation and homepage, [Symbolic
Analysis of Grants](https://www.brz.gv.at/en/BRZ-Tech-Blog/Tech-Blog-7-Symbolic-Analysis-of-Grants.html)
by the Austrian Federal Computing Center, and parts of the
[precautionary](https://github.com/dcnorris/precautionary/tree/main/exec/prolog)
package for the analysis of dose-escalation trials in the
safety-critical and highly regulated domain of oncology
trial&nbsp;design.
Scryer Prolog is also very well suited for teaching and learning
Prolog, and for testing syntactic conformance and hence portability of
existing Prolog&nbsp;programs.
## Support and discussions
If Scryer Prolog crashes or yields unexpected errors, consider filing
an&nbsp;[issue](https://github.com/mthom/scryer-prolog/issues).
To get in touch with the Scryer Prolog community, participate in
[discussions](https://github.com/mthom/scryer-prolog/discussions)!
[discussions](https://github.com/mthom/scryer-prolog/discussions)
or visit our #scryer IRC channel on [Libera](https://libera.chat)!

File diff suppressed because it is too large Load Diff

View File

@@ -1,7 +1,7 @@
use proc_macro2::TokenStream;
use syn::*;
use syn::parse::*;
use syn::visit::*;
use syn::*;
use indexmap::IndexSet;
@@ -11,7 +11,9 @@ struct StaticStrVisitor {
impl StaticStrVisitor {
fn new() -> Self {
Self { static_strs: IndexSet::new() }
Self {
static_strs: IndexSet::new(),
}
}
}
@@ -150,7 +152,7 @@ pub fn index_static_strings(instruction_rs_path: &std::path::Path) -> TokenStrea
Err(_) => {}
}
let indices = (0..visitor.static_strs.len()).map(|i| i << 3);
let indices = (0..visitor.static_strs.len()).map(|i| (i << 3) as u64);
let indices_iter = indices.clone();
let static_strs_len = visitor.static_strs.len();

491
flamegraph.svg Normal file

File diff suppressed because one or more lines are too long

After

Width:  |  Height:  |  Size: 4.8 MiB

0
log.txt Normal file
View File

View File

@@ -1,31 +1,28 @@
<?xml version="1.0" encoding="utf-8"?>
<Wix xmlns="http://schemas.microsoft.com/wix/2006/wi">
<Product Name="Scryer Prolog" Manufacturer="Scryer Prolog contributors" Id="*" UpgradeCode="cfb2dee4-5dd5-4d7d-b426-cd7340810559" Language="1033" Codepage="1252" Version="0.9.0">
<Package Description="An open source industrial strength production environment for ISO Prolog that is also a testbed for bleeding edge research in logic and constraint programming, which is itself written in a high-level language." Platform="x64" Keywords="prolog" Id="*" Compressed="yes" InstallScope="perMachine" InstallerVersion="300" Languages="1033" SummaryCodepage="1252" Manufacturer="Scryer Prolog contributors"/>
<Property Id="APPHELPLINK" Value="https://github.com/mthom/scryer-prolog"/>
<Media Id="1" Cabinet="scryer.cab" EmbedCab="yes" />
<Directory Id="TARGETDIR" Name="SourceDir">
<Directory Id="ProgramFilesFolder" Name="PFiles">
<Directory Id="INSTALLDIR" Name="Scryer Prolog">
<Component Id="MainExecutable" Guid="1b41ceda-ba18-47f9-911b-ee41b4f20921">
<File Id="ScryerPrologEXE" Name="scryer-prolog.exe" DiskId="1" Source="target/release/scryer-prolog.exe" KeyPath="yes" Checksum="yes"/>
</Component>
</Directory>
</Directory>
<Directory Id="ProgramMenuFolder">
<Component Id="ApplicationShortcut" Guid="8c9b14a3-e7b1-4d30-a892-61d7371dcae2">
<Shortcut Id="ApplicationStarMenuShortcut" Name="Scryer Prolog" Description="Launch Scryer Prolog" Target="[#ScryerPrologEXE]" WorkingDirectory="INSTALLDIR"/>
<RemoveFolder Id="ApplicationShortcut" On="uninstall"/>
<RegistryValue Root="HKCU" Key="Software\Microsoft\ScryerProlog" Name="installed" Type="integer" Value="1" KeyPath="yes"/>
</Component>
</Directory>
</Directory>
<Feature Id="Complete" Level="1" Display="expand" ConfigurableDirectory="INSTALLDIR">
<ComponentRef Id="MainExecutable"/>
<ComponentRef Id="ApplicationShortcut"/>
</Feature>
</Product>
</Wix>
<?xml version="1.0" encoding="utf-8"?>
<Wix xmlns="http://schemas.microsoft.com/wix/2006/wi">
<Product Name="Scryer Prolog" Manufacturer="Scryer Prolog contributors" Id="*" UpgradeCode="cfb2dee4-5dd5-4d7d-b426-cd7340810559" Language="1033" Codepage="1252" Version="0.9.0">
<Package Description="An open source industrial strength production environment for ISO Prolog that is also a testbed for bleeding edge research in logic and constraint programming, which is itself written in a high-level language." Platform="x64" Keywords="prolog" Id="*" Compressed="yes" InstallScope="perMachine" InstallerVersion="300" Languages="1033" SummaryCodepage="1252" Manufacturer="Scryer Prolog contributors"/>
<Property Id="APPHELPLINK" Value="https://github.com/mthom/scryer-prolog"/>
<Media Id="1" Cabinet="scryer.cab" EmbedCab="yes" />
<Directory Id="TARGETDIR" Name="SourceDir">
<Directory Id="ProgramFilesFolder" Name="PFiles">
<Directory Id="INSTALLDIR" Name="Scryer Prolog">
<Component Id="MainExecutable" Guid="1b41ceda-ba18-47f9-911b-ee41b4f20921">
<File Id="ScryerPrologEXE" Name="scryer-prolog.exe" DiskId="1" Source="target/release/scryer-prolog.exe" KeyPath="yes" Checksum="yes"/>
</Component>
</Directory>
</Directory>
<Directory Id="ProgramMenuFolder">
<Component Id="ApplicationShortcut" Guid="8c9b14a3-e7b1-4d30-a892-61d7371dcae2">
<Shortcut Id="ApplicationStarMenuShortcut" Name="Scryer Prolog" Description="Launch Scryer Prolog" Target="[#ScryerPrologEXE]" WorkingDirectory="INSTALLDIR"/>
<RemoveFolder Id="ApplicationShortcut" On="uninstall"/>
<RegistryValue Root="HKCU" Key="Software\Microsoft\ScryerProlog" Name="installed" Type="integer" Value="1" KeyPath="yes"/>
</Component>
</Directory>
</Directory>
<Feature Id="Complete" Level="1" Display="expand" ConfigurableDirectory="INSTALLDIR">
<ComponentRef Id="MainExecutable"/>
<ComponentRef Id="ApplicationShortcut"/>
</Feature>
</Product>
</Wix>

View File

@@ -1,14 +1,10 @@
use crate::parser::ast::*;
use crate::temp_v;
use crate::fixtures::*;
use crate::forms::*;
use crate::instructions::*;
use crate::machine::machine_indices::*;
use crate::targets::*;
use std::cell::Cell;
use std::rc::Rc;
pub(crate) trait Allocator {
fn new() -> Self;
@@ -17,7 +13,7 @@ pub(crate) trait Allocator {
&mut self,
lvl: Level,
context: GenContext,
code: &mut Code,
code: &mut CodeDeque,
);
fn mark_non_var<'a, Target: CompilationTarget<'a>>(
@@ -25,83 +21,71 @@ pub(crate) trait Allocator {
lvl: Level,
context: GenContext,
cell: &'a Cell<RegType>,
code: &mut Code,
code: &mut CodeDeque,
);
fn mark_reserved_var<'a, Target: CompilationTarget<'a>>(
&mut self,
var_name: Rc<String>,
var_num: usize,
lvl: Level,
cell: &'a Cell<VarReg>,
term_loc: GenContext,
code: &mut Code,
code: &mut CodeDeque,
r: RegType,
is_new_var: bool,
);
fn mark_cut_var(&mut self, var_num: usize, chunk_num: usize) -> RegType;
fn mark_var<'a, Target: CompilationTarget<'a>>(
&mut self,
var_name: Rc<String>,
var_num: usize,
lvl: Level,
cell: &'a Cell<VarReg>,
context: GenContext,
code: &mut Code,
code: &mut CodeDeque,
);
fn reset(&mut self);
fn reset_contents(&mut self) {}
fn reset_arg(&mut self, arg_num: usize);
fn reset_at_head(&mut self, args: &Vec<Term>);
fn reset_contents(&mut self);
fn advance_arg(&mut self);
/*
fn bindings(&self) -> &AllocVarDict;
fn bindings_mut(&mut self) -> &mut AllocVarDict;
fn take_bindings(self) -> AllocVarDict;
*/
fn max_reg_allocated(&self) -> usize;
// TODO: wha.. why?? grrr. it drains the VarStatus data from vs (which it owns!)
// into self.bindings and perm_vs after all is computed (i.e. vs.populate_restricting_sets()
// and vs.set_perm_vals(has_deep_cut) have both been called).
/*
fn drain_var_data<'a>(
&mut self,
vs: VariableFixtures<'a>,
vs: VariableFixtures,
num_of_chunks: usize,
) -> VariableFixtures<'a> {
) -> VariableFixtures {
let mut perm_vs = VariableFixtures::new();
for (var, (var_status, cells)) in vs.into_iter() {
for (var, var_status) in vs.into_iter() {
match var_status {
VarStatus::Temp(chunk_num, tvd) => {
self.bindings_mut()
.insert(var.clone(), VarData::Temp(chunk_num, 0, tvd));
if chunk_num + 1 == num_of_chunks {
perm_vs.insert_last_chunk_temp_var(var);
}
.insert(var.clone(), VarAlloc::Temp(chunk_num, 0, tvd));
}
VarStatus::Perm(_) => {
self.bindings_mut().insert(var.clone(), VarData::Perm(0));
perm_vs.insert(var, (var_status, cells));
self.bindings_mut().insert(var.clone(), VarAlloc::Perm(0));
perm_vs.insert(var, var_status);
}
};
}
perm_vs
}
fn get(&self, var: Rc<String>) -> RegType {
self.bindings()
.get(&var)
.map_or(temp_v!(0), |v| v.as_reg_type())
}
fn is_unbound(&self, var: Rc<String>) -> bool {
self.get(var).reg_num() == 0
}
fn record_register(&mut self, var: Rc<String>, r: RegType) {
match self.bindings_mut().get_mut(&var).unwrap() {
&mut VarData::Temp(_, ref mut s, _) => *s = r.reg_num(),
&mut VarData::Perm(ref mut s) => *s = r.reg_num(),
}
}
*/
}

View File

@@ -1,27 +1,34 @@
#[cfg(feature = "http")]
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::rcu::Rcu;
use crate::rcu::RcuRef;
use crate::read::*;
use crate::parser::dashu::{Integer, Rational};
use ordered_float::OrderedFloat;
use crate::parser::rug::{Integer, Rational};
use std::alloc;
use std::cell::UnsafeCell;
use std::fmt;
use std::hash::{Hash, Hasher};
use std::mem;
use std::net::TcpListener;
use std::ops::{Deref, DerefMut};
use std::ptr;
use std::sync::RwLock;
#[macro_export]
macro_rules! arena_alloc {
($e:expr, $arena:expr) => {{
let result = $e;
#[allow(unused_unsafe)]
unsafe { ArenaAllocated::alloc($arena, result) }
unsafe {
ArenaAllocated::alloc($arena, result)
}
}};
}
@@ -30,24 +37,36 @@ macro_rules! float_alloc {
($e:expr, $arena:expr) => {{
let result = $e;
#[allow(unused_unsafe)]
unsafe { $arena.f64_tbl.build_with(result) }
unsafe {
$arena.f64_tbl.build_with(result).as_ptr()
}
}};
}
#[cfg(test)]
use std::cell::RefCell;
use std::sync::Arc;
use std::sync::Mutex;
use std::sync::Weak;
const F64_TABLE_INIT_SIZE: usize = 1 << 16;
const F64_TABLE_ALIGN: usize = 8;
#[cfg(test)]
thread_local! {
static F64_TABLE_BUF_BASE: RefCell<*const u8> = RefCell::new(ptr::null_mut());
#[inline(always)]
fn global_f64table() -> &'static RwLock<Weak<F64Table>> {
#[cfg(feature = "rust_beta_channel")]
{
// const Weak::new will be stabilized in 1.73 which is currently in beta,
// till then we need a OnceLock for initialization
static GLOBAL_ATOM_TABLE: RwLock<Weak<F64Table>> = RwLock::const_new(Weak::new());
&GLOBAL_ATOM_TABLE
}
#[cfg(not(feature = "rust_beta_channel"))]
{
use std::sync::OnceLock;
static GLOBAL_ATOM_TABLE: OnceLock<RwLock<Weak<F64Table>>> = OnceLock::new();
GLOBAL_ATOM_TABLE.get_or_init(|| RwLock::new(Weak::new()))
}
}
#[cfg(not(test))]
static mut F64_TABLE_BUF_BASE: *const u8 = ptr::null_mut();
impl RawBlockTraits for F64Table {
#[inline]
fn init_size() -> usize {
@@ -62,69 +81,87 @@ impl RawBlockTraits for F64Table {
#[derive(Debug)]
pub struct F64Table {
block: RawBlock<F64Table>,
}
impl Drop for F64Table {
fn drop(&mut self) {
self.block.deallocate();
}
}
#[cfg(test)]
fn set_f64_tbl_buf_base(ptr: *const u8) {
F64_TABLE_BUF_BASE.with(|f64_table_buf_base| {
*f64_table_buf_base.borrow_mut() = ptr;
});
}
#[cfg(test)]
pub(crate) fn get_f64_tbl_buf_base() -> *const u8 {
F64_TABLE_BUF_BASE.with(|f64_table_buf_base| *f64_table_buf_base.borrow())
}
#[cfg(not(test))]
fn set_f64_tbl_buf_base(ptr: *const u8) {
unsafe {
F64_TABLE_BUF_BASE = ptr;
}
}
#[cfg(not(test))]
pub(crate) fn get_f64_tbl_buf_base() -> *const u8 {
unsafe { F64_TABLE_BUF_BASE }
block: Rcu<RawBlock<F64Table>>,
update: Mutex<()>,
}
#[inline(always)]
pub fn lookup_float(offset: usize) -> *mut OrderedFloat<f64> {
let base = get_f64_tbl_buf_base() as usize;
(base + offset) as *mut _
pub fn lookup_float(
offset: F64Offset,
) -> RcuRef<RawBlock<F64Table>, UnsafeCell<OrderedFloat<f64>>> {
let f64table = global_f64table()
.read()
.unwrap()
.upgrade()
.expect("We should only be looking up floats while there is a float table");
RcuRef::try_map(f64table.block.active_epoch(), |raw_block| unsafe {
raw_block
.base
.offset(offset.0 as isize)
.cast_mut()
.cast::<UnsafeCell<OrderedFloat<f64>>>()
.as_ref()
})
.expect("The offset should result in a non-null pointer")
}
impl F64Table {
#[inline]
pub fn new() -> Self {
let table = Self { block: RawBlock::new() };
set_f64_tbl_buf_base(table.block.base);
table
pub fn new() -> Arc<Self> {
let upgraded = global_f64table().read().unwrap().upgrade();
// don't inline upgraded, otherwise temporary will be dropped too late in case of None
if let Some(atom_table) = upgraded {
atom_table
} else {
let mut guard = global_f64table().write().unwrap();
// try to upgrade again in case we lost the race on the write lock
if let Some(atom_table) = guard.upgrade() {
atom_table
} else {
let atom_table = Arc::new(Self {
block: Rcu::new(RawBlock::new()),
update: Mutex::new(()),
});
*guard = Arc::downgrade(&atom_table);
atom_table
}
}
}
pub unsafe fn build_with(&mut self, value: f64) -> F64Ptr {
pub unsafe fn build_with(&self, value: f64) -> F64Offset {
let update_guard = self.update.lock();
// we don't have an index table for lookups as AtomTable does so
// just get the epoch after we take the upgrade lock
let mut block_epoch = self.block.active_epoch();
let mut ptr;
loop {
ptr = self.block.alloc(mem::size_of::<f64>());
ptr = block_epoch.alloc(mem::size_of::<f64>());
if ptr.is_null() {
self.block.grow();
set_f64_tbl_buf_base(self.block.base);
let new_block = block_epoch.grow_new().unwrap();
self.block.replace(new_block);
block_epoch = self.block.active_epoch();
} else {
break;
}
}
ptr::write(ptr as *mut OrderedFloat<f64>, OrderedFloat(value));
F64Ptr(ptr::NonNull::new_unchecked(ptr as *mut _))
let float = F64Offset {
0: ptr as usize - block_epoch.base as usize,
};
// atometable would have to update the index table at this point
// expicit drop to ensure we don't accidentally drop it early
drop(update_guard);
float
}
}
@@ -133,14 +170,13 @@ impl F64Table {
pub enum ArenaHeaderTag {
Integer = 0b10,
Rational = 0b11,
OssifiedOpDir = 0b0000100,
LiveLoadState = 0b0001000,
InactiveLoadState = 0b1011000,
InputFileStream = 0b10000,
OutputFileStream = 0b10100,
NamedTcpStream = 0b011100,
NamedTlsStream = 0b100000,
HttpReadStream = 0b100001,
HttpReadStream = 0b100001,
HttpWriteStream = 0b100010,
ReadlineStream = 0b110000,
StaticStringStream = 0b110100,
@@ -242,9 +278,11 @@ impl<T: fmt::Display> fmt::Display for TypedArenaPtr<T> {
}
impl<T: ?Sized + ArenaAllocated> TypedArenaPtr<T> {
// data must be allocated in the arena already.
#[inline]
pub const fn new(data: *mut T) -> Self {
unsafe { TypedArenaPtr(ptr::NonNull::new_unchecked(data)) }
let result = unsafe { TypedArenaPtr(ptr::NonNull::new_unchecked(data)) };
result
}
#[inline]
@@ -273,7 +311,9 @@ impl<T: ?Sized + ArenaAllocated> TypedArenaPtr<T> {
#[inline]
pub fn set_tag(&mut self, tag: ArenaHeaderTag) {
unsafe { (*self.header_ptr_mut()).set_tag(tag); }
unsafe {
(*self.header_ptr_mut()).set_tag(tag);
}
}
#[inline]
@@ -304,12 +344,16 @@ pub trait ArenaAllocated: Sized {
fn copy_to_arena(self, dst: *mut Self) -> Self::PtrToAllocated;
fn header_offset_from_payload() -> usize {
mem::size_of::<*const ArenaHeader>()
mem::size_of::<ArenaHeader>()
}
unsafe fn alloc(arena: &mut Arena, value: Self) -> Self::PtrToAllocated {
let size = value.size() + mem::size_of::<AllocSlab>();
#[cfg(target_pointer_width = "32")]
let align = mem::align_of::<AllocSlab>() * 2;
#[cfg(target_pointer_width = "64")]
let align = mem::align_of::<AllocSlab>();
let layout = alloc::Layout::from_size_align_unchecked(size, align);
@@ -327,12 +371,18 @@ pub trait ArenaAllocated: Sized {
}
}
#[derive(Copy, Clone, Debug)]
pub struct F64Ptr(pub ptr::NonNull<OrderedFloat<f64>>);
#[derive(Debug)]
pub struct F64Ptr(RcuRef<RawBlock<F64Table>, UnsafeCell<OrderedFloat<f64>>>);
impl Clone for F64Ptr {
fn clone(&self) -> Self {
Self(RcuRef::clone(&self.0))
}
}
impl PartialEq for F64Ptr {
fn eq(&self, other: &F64Ptr) -> bool {
self.0 == other.0 || &**self == &**other
RcuRef::ptr_eq(&self.0, &other.0) || self.deref() == other.deref()
}
}
@@ -368,28 +418,26 @@ impl Deref for F64Ptr {
#[inline]
fn deref(&self) -> &Self::Target {
unsafe { &*self.0.as_ptr() }
unsafe { &*self.0.get().as_ref().unwrap() }
}
}
impl DerefMut for F64Ptr {
#[inline]
fn deref_mut(&mut self) -> &mut Self::Target {
unsafe { &mut *self.0.as_ptr() }
unsafe { &mut *self.0.get().as_mut().unwrap() }
}
}
impl F64Ptr {
#[inline(always)]
pub fn from_offset(offset: usize) -> Self {
unsafe {
F64Ptr(ptr::NonNull::new_unchecked(lookup_float(offset)))
}
pub fn from_offset(offset: F64Offset) -> Self {
Self(lookup_float(offset))
}
#[inline(always)]
pub fn as_offset(&self) -> F64Offset {
F64Offset(self.0.as_ptr() as usize - get_f64_tbl_buf_base() as usize)
F64Offset(self.0.get() as usize - RcuRef::get_root(&self.0).base as usize)
}
}
@@ -409,7 +457,7 @@ impl F64Offset {
#[inline(always)]
pub fn as_ptr(self) -> F64Ptr {
F64Ptr::from_offset(self.0)
F64Ptr::from_offset(self)
}
#[inline(always)]
@@ -498,28 +546,6 @@ impl ArenaAllocated for Rational {
}
}
impl ArenaAllocated for OssifiedOpDir {
type PtrToAllocated = TypedArenaPtr<OssifiedOpDir>;
#[inline]
fn tag() -> ArenaHeaderTag {
ArenaHeaderTag::OssifiedOpDir
}
#[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 LiveLoadState {
type PtrToAllocated = TypedArenaPtr<LiveLoadState>;
@@ -564,47 +590,49 @@ impl ArenaAllocated for TcpListener {
}
}
#[cfg(feature = "http")]
impl ArenaAllocated for HttpListener {
type PtrToAllocated = TypedArenaPtr<HttpListener>;
#[inline]
fn tag() -> ArenaHeaderTag {
ArenaHeaderTag::HttpListener
ArenaHeaderTag::HttpListener
}
#[inline]
fn size(&self) -> usize {
mem::size_of::<Self>()
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)
}
unsafe {
ptr::write(dst, self);
TypedArenaPtr::new(dst as *mut Self)
}
}
}
#[cfg(feature = "http")]
impl ArenaAllocated for HttpResponse {
type PtrToAllocated = TypedArenaPtr<HttpResponse>;
#[inline]
fn tag() -> ArenaHeaderTag {
ArenaHeaderTag::HttpResponse
ArenaHeaderTag::HttpResponse
}
#[inline]
fn size(&self) -> usize {
mem::size_of::<Self>()
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)
}
unsafe {
ptr::write(dst, self);
TypedArenaPtr::new(dst as *mut Self)
}
}
}
@@ -651,16 +679,19 @@ impl ArenaAllocated for IndexPtr {
}
}
#[repr(C)]
#[derive(Clone, Copy, Debug)]
struct AllocSlab {
next: *mut AllocSlab,
#[cfg(target_pointer_width = "32")]
_padding: u32,
header: ArenaHeader,
}
#[derive(Debug)]
pub struct Arena {
base: *mut AllocSlab,
pub f64_tbl: F64Table,
pub f64_tbl: Arc<F64Table>,
}
unsafe impl Send for Arena {}
@@ -669,7 +700,10 @@ unsafe impl Sync for Arena {}
impl Arena {
#[inline]
pub fn new() -> Self {
Arena { base: ptr::null_mut(), f64_tbl: F64Table::new() }
Arena {
base: ptr::null_mut(),
f64_tbl: F64Table::new(),
}
}
}
@@ -693,14 +727,17 @@ unsafe fn drop_slab_in_place(value: &mut AllocSlab) {
ptr::drop_in_place(value.payload_offset::<StreamLayout<CharReader<NamedTcpStream>>>());
}
ArenaHeaderTag::NamedTlsStream => {
#[cfg(feature = "tls")]
ptr::drop_in_place(value.payload_offset::<StreamLayout<CharReader<NamedTlsStream>>>());
}
ArenaHeaderTag::HttpReadStream => {
#[cfg(feature = "http")]
ptr::drop_in_place(value.payload_offset::<StreamLayout<CharReader<HttpReadStream>>>());
}
ArenaHeaderTag::HttpWriteStream => {
ptr::drop_in_place(value.payload_offset::<StreamLayout<CharReader<HttpWriteStream>>>());
}
ArenaHeaderTag::HttpWriteStream => {
#[cfg(feature = "http")]
ptr::drop_in_place(value.payload_offset::<StreamLayout<CharReader<HttpWriteStream>>>());
}
ArenaHeaderTag::ReadlineStream => {
ptr::drop_in_place(value.payload_offset::<StreamLayout<ReadlineStream>>());
}
@@ -710,33 +747,32 @@ unsafe fn drop_slab_in_place(value: &mut AllocSlab) {
ArenaHeaderTag::ByteStream => {
ptr::drop_in_place(value.payload_offset::<StreamLayout<CharReader<ByteStream>>>());
}
ArenaHeaderTag::OssifiedOpDir => {
ptr::drop_in_place(value.payload_offset::<OssifiedOpDir>());
}
ArenaHeaderTag::LiveLoadState | ArenaHeaderTag::InactiveLoadState => {
ptr::drop_in_place(value.payload_offset::<LiveLoadState>());
}
ArenaHeaderTag::Dropped => {
}
ArenaHeaderTag::Dropped => {}
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::HttpListener => {
#[cfg(feature = "http")]
ptr::drop_in_place(value.payload_offset::<HttpListener>());
}
ArenaHeaderTag::HttpResponse => {
#[cfg(feature = "http")]
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::IndexPtrUndefined |
ArenaHeaderTag::IndexPtrDynamicUndefined | ArenaHeaderTag::IndexPtrDynamicIndex |
ArenaHeaderTag::IndexPtrIndex => {
}
ArenaHeaderTag::NullStream
| ArenaHeaderTag::IndexPtrUndefined
| ArenaHeaderTag::IndexPtrDynamicUndefined
| ArenaHeaderTag::IndexPtrDynamicIndex
| ArenaHeaderTag::IndexPtrIndex => {}
}
}
@@ -784,23 +820,25 @@ const_assert!(mem::size_of::<OrderedFloat<f64>>() == 8);
#[cfg(test)]
mod tests {
use std::ops::Deref;
use crate::machine::mock_wam::*;
use crate::machine::partial_string::*;
use crate::parser::dashu::{Integer, Rational};
use ordered_float::OrderedFloat;
use crate::parser::rug::{Integer, Rational};
#[test]
fn float_ptr_cast() {
let mut wam = MockWAM::new();
let wam = MockWAM::new();
let f = 0f64;
let fp = float_alloc!(f, wam.machine_st.arena);
let mut cell = HeapCellValue::from(fp);
let mut cell = HeapCellValue::from(fp.clone());
assert_eq!(cell.get_tag(), HeapCellValueTag::F64);
assert_eq!(cell.get_mark_bit(), false);
assert_eq!(*fp, OrderedFloat(f));
assert_eq!(fp.deref(), &OrderedFloat(f));
cell.set_mark_bit(true);
@@ -817,6 +855,12 @@ mod tests {
#[test]
fn heap_cell_value_const_cast() {
let mut wam = MockWAM::new();
#[cfg(target_pointer_width = "32")]
let const_value = HeapCellValue::from(ConsPtr::build_with(
0x0000_0431 as *const _,
ConsPtrMaskTag::Cons,
));
#[cfg(target_pointer_width = "64")]
let const_value = HeapCellValue::from(ConsPtr::build_with(
0x0000_5555_ff00_0431 as *const _,
ConsPtrMaskTag::Cons,
@@ -824,7 +868,10 @@ mod tests {
match const_value.to_untyped_arena_ptr() {
Some(arena_ptr) => {
assert_eq!(arena_ptr.into_bytes(), const_value.into_bytes());
assert_eq!(
arena_ptr.into_bytes(),
const_value.to_untyped_arena_ptr_bytes()
);
}
None => {
assert!(false);
@@ -837,7 +884,10 @@ mod tests {
match stream_cell.to_untyped_arena_ptr() {
Some(arena_ptr) => {
assert_eq!(arena_ptr.into_bytes(), stream_cell.into_bytes());
assert_eq!(
arena_ptr.into_bytes(),
stream_cell.to_untyped_arena_ptr_bytes()
);
}
None => {
assert!(false);
@@ -852,8 +902,7 @@ mod tests {
// integer
let big_int: Integer = 2 * Integer::from(1u64 << 63);
let big_int_ptr: TypedArenaPtr<Integer> =
arena_alloc!(big_int, &mut 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());
@@ -889,7 +938,7 @@ mod tests {
// rational
let big_rat = 2 * Rational::from(1u64 << 63);
let big_rat = Rational::from(2) * Rational::from(1u64 << 63);
let big_rat_ptr: TypedArenaPtr<Rational> = arena_alloc!(big_rat, &mut wam.machine_st.arena);
assert!(!big_rat_ptr.as_ptr().is_null());
@@ -915,7 +964,7 @@ mod tests {
(HeapCellValueTag::Cons, cons_ptr) => {
match_untyped_arena_ptr!(cons_ptr,
(ArenaHeaderTag::Rational, n) => {
assert_eq!(&*n, &(2 * Rational::from(1u64 << 63)));
assert_eq!(&*n, &(Rational::from(2) * Rational::from(1u64 << 63)));
}
_ => unreachable!()
)
@@ -928,8 +977,8 @@ mod tests {
let f_atom = atom!("f");
let g_atom = atom!("g");
assert_eq!(f_atom.as_str(), "f");
assert_eq!(g_atom.as_str(), "g");
assert_eq!(&*f_atom.as_str(), "f");
assert_eq!(&*g_atom.as_str(), "g");
let f_atom_cell = atom_as_cell!(f_atom);
let g_atom_cell = atom_as_cell!(g_atom);
@@ -939,7 +988,7 @@ mod tests {
match f_atom_cell.to_atom() {
Some(atom) => {
assert_eq!(f_atom, atom);
assert_eq!(atom.as_str(), "f");
assert_eq!(&*atom.as_str(), "f");
}
None => {
assert!(false);
@@ -950,7 +999,7 @@ mod tests {
(HeapCellValueTag::Atom, (atom, arity)) => {
assert_eq!(f_atom, atom);
assert_eq!(arity, 0);
assert_eq!(atom.as_str(), "f");
assert_eq!(&*atom.as_str(), "f");
}
_ => { unreachable!() }
);
@@ -959,21 +1008,22 @@ mod tests {
(HeapCellValueTag::Atom, (atom, arity)) => {
assert_eq!(g_atom, atom);
assert_eq!(arity, 0);
assert_eq!(atom.as_str(), "g");
assert_eq!(&*atom.as_str(), "g");
}
_ => { unreachable!() }
);
// complete string
let pstr_var_cell = put_partial_string(&mut wam.machine_st.heap, "ronan", &mut wam.machine_st.atom_tbl);
let pstr_var_cell =
put_partial_string(&mut wam.machine_st.heap, "ronan", &wam.machine_st.atom_tbl);
let pstr_cell = wam.machine_st.heap[pstr_var_cell.get_value() as usize];
assert_eq!(pstr_cell.get_tag(), HeapCellValueTag::PStr);
match pstr_cell.to_pstr() {
Some(pstr) => {
assert_eq!(pstr.as_str_from(0), "ronan");
assert_eq!(&*pstr.as_str_from(0), "ronan");
}
None => {
assert!(false);
@@ -983,7 +1033,7 @@ mod tests {
read_heap_cell!(pstr_cell,
(HeapCellValueTag::PStr, pstr_atom) => {
let pstr = PartialString::from(pstr_atom);
assert_eq!(pstr.as_str_from(0), "ronan");
assert_eq!(&*pstr.as_str_from(0), "ronan");
}
_ => { unreachable!() }
);
@@ -1091,8 +1141,8 @@ mod tests {
read_heap_cell!(cell,
(HeapCellValueTag::Atom, (el, _arity)) => {
assert_eq!(el.flat_index() as usize, empty_list_as_cell!().get_value());
assert_eq!(el.as_str(), "[]");
assert_eq!(el.flat_index(), empty_list_as_cell!().get_value());
assert_eq!(&*el.as_str(), "[]");
}
_ => { unreachable!() }
);

View File

@@ -9,11 +9,13 @@ use crate::targets::QueryInstruction;
use crate::types::*;
use crate::parser::ast::*;
use crate::parser::rug::ops::PowAssign;
use crate::parser::rug::{Assign, Integer, Rational};
use crate::parser::dashu::{Integer, Rational};
use crate::machine::machine_errors::*;
use dashu::base::Abs;
use dashu::base::BitTest;
use num_order::NumOrd;
use ordered_float::*;
use std::cell::Cell;
@@ -22,7 +24,6 @@ use std::convert::TryFrom;
use std::f64;
use std::num::FpCategory;
use std::ops::Div;
use std::rc::Rc;
use std::vec::Vec;
#[derive(Debug, Copy, Clone, PartialEq, Eq)]
@@ -53,7 +54,7 @@ pub(crate) struct ArithInstructionIterator<'a> {
state_stack: Vec<TermIterState<'a>>,
}
pub(crate) type ArithCont = (Code, Option<ArithmeticTerm>);
pub(crate) type ArithCont = (CodeDeque, Option<ArithmeticTerm>);
impl<'a> ArithInstructionIterator<'a> {
fn push_subterm(&mut self, lvl: Level, term: &'a Term) {
@@ -67,19 +68,6 @@ impl<'a> ArithInstructionIterator<'a> {
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))
}
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(
@@ -87,7 +75,7 @@ impl<'a> ArithInstructionIterator<'a> {
2,
))
}
Term::Var(cell, var) => TermIterState::Var(Level::Shallow, cell, var.clone()),
Term::Var(cell, var_ptr) => TermIterState::Var(Level::Shallow, cell, var_ptr.clone()),
};
Ok(ArithInstructionIterator {
@@ -100,7 +88,7 @@ impl<'a> ArithInstructionIterator<'a> {
pub(crate) enum ArithTermRef<'a> {
Literal(&'a Literal),
Op(Atom, usize), // name, arity.
Var(Level, &'a Cell<VarReg>, Rc<String>),
Var(Level, &'a Cell<VarReg>, VarPtr),
}
impl<'a> Iterator for ArithInstructionIterator<'a> {
@@ -128,8 +116,8 @@ impl<'a> Iterator for ArithInstructionIterator<'a> {
}
}
TermIterState::Literal(_, _, c) => return Some(Ok(ArithTermRef::Literal(c))),
TermIterState::Var(lvl, cell, var) => {
return Some(Ok(ArithTermRef::Var(lvl, cell, var.clone())));
TermIterState::Var(lvl, cell, var_ptr) => {
return Some(Ok(ArithTermRef::Var(lvl, cell, var_ptr)));
}
_ => {
return Some(Err(ArithmeticError::NonEvaluableFunctor(
@@ -172,13 +160,13 @@ fn push_literal(interm: &mut Vec<ArithmeticTerm>, c: &Literal) -> Result<(), Ari
Literal::Float(n) => interm.push(ArithmeticTerm::Number(Number::Float(*n.as_ptr()))),
Literal::Rational(n) => interm.push(ArithmeticTerm::Number(Number::Rational(*n))),
Literal::Atom(name) if name == &atom!("e") => interm.push(ArithmeticTerm::Number(
Number::Float(OrderedFloat(std::f64::consts::E))
Number::Float(OrderedFloat(std::f64::consts::E)),
)),
Literal::Atom(name) if name == &atom!("pi") => interm.push(ArithmeticTerm::Number(
Number::Float(OrderedFloat(std::f64::consts::PI))
Number::Float(OrderedFloat(std::f64::consts::PI)),
)),
Literal::Atom(name) if name == &atom!("epsilon") => interm.push(ArithmeticTerm::Number(
Number::Float(OrderedFloat(std::f64::EPSILON))
Number::Float(OrderedFloat(std::f64::EPSILON)),
)),
_ => return Err(ArithmeticError::NonEvaluableFunctor(*c, 0)),
}
@@ -219,6 +207,8 @@ impl<'a> ArithmeticEvaluator<'a> {
atom!("round") => Ok(Instruction::Round(a1, t)),
atom!("ceiling") => Ok(Instruction::Ceiling(a1, t)),
atom!("floor") => Ok(Instruction::Floor(a1, t)),
atom!("float_integer_part") => Ok(Instruction::FloatIntegerPart(a1, t)),
atom!("float_fractional_part") => Ok(Instruction::FloatFractionalPart(a1, t)),
atom!("sign") => Ok(Instruction::Sign(a1, t)),
atom!("\\") => Ok(Instruction::BitwiseComplement(a1, t)),
_ => Err(ArithmeticError::NonEvaluableFunctor(Literal::Atom(name), 1)),
@@ -320,41 +310,40 @@ impl<'a> ArithmeticEvaluator<'a> {
src: &'a Term,
term_loc: GenContext,
arg: usize,
) -> Result<ArithCont, ArithmeticError>
{
let mut code = vec![];
) -> Result<ArithCont, ArithmeticError> {
let mut code = CodeDeque::new();
let mut iter = src.iter()?;
while let Some(term_ref) = iter.next() {
match term_ref? {
ArithTermRef::Literal(c) => push_literal(&mut self.interm, c)?,
ArithTermRef::Var(lvl, cell, name) => {
let r = if lvl == Level::Shallow {
self.marker.mark_non_callable(
name.clone(),
arg,
term_loc,
cell,
&mut code,
)
} else if term_loc.is_last() || cell.get().norm().reg_num() == 0 {
self.marker.mark_var::<QueryInstruction>(
name.clone(),
lvl,
cell,
term_loc,
&mut code,
);
let var_num = name.to_var_num().unwrap();
self.marker.get_binding(&name).unwrap()
let r = if lvl == Level::Shallow {
self.marker
.mark_non_callable(var_num, arg, term_loc, cell, &mut code)
} else if term_loc.is_last() || cell.get().norm().reg_num() == 0 {
let r = self.marker.get_binding(var_num);
if r.reg_num() == 0 {
self.marker.mark_var::<QueryInstruction>(
var_num, lvl, cell, term_loc, &mut code,
);
cell.get().norm()
} else {
self.marker.increment_running_count(var_num);
r
}
} else {
self.marker.increment_running_count(var_num);
cell.get().norm()
};
self.interm.push(ArithmeticTerm::Reg(r));
}
ArithTermRef::Op(name, arity) => {
code.push(self.instr_from_clause(name, arity)?);
code.push_back(self.instr_from_clause(name, arity)?);
}
}
}
@@ -367,8 +356,9 @@ impl<'a> ArithmeticEvaluator<'a> {
pub(crate) fn rnd_i<'a>(n: &'a Number, arena: &mut Arena) -> Number {
match n {
&Number::Integer(i) => {
if let Some(n) = i.to_i64() {
fixnum!(Number, n, arena)
let result = (&*i).try_into();
if let Ok(value) = result{
fixnum!(Number, value, arena)
} else {
*n
}
@@ -383,16 +373,14 @@ pub(crate) fn rnd_i<'a>(n: &'a Number, arena: &mut Arena) -> Number {
if I64_MIN_TO_F <= f && f <= I64_MAX_TO_F {
fixnum!(Number, f.into_inner() as i64, arena)
} else {
Number::Integer(arena_alloc!(Integer::from_f64(f.into_inner()).unwrap(), arena))
Number::Integer(arena_alloc!(Integer::from(f.0 as i64), arena))
}
}
&Number::Rational(ref r) => {
let r_ref = r.fract_floor_ref();
let (mut fract, mut floor) = (Rational::new(), Integer::new());
(&mut fract, &mut floor).assign(r_ref);
let (_, floor) = (r.fract(), r.floor());
if let Some(floor) = floor.to_i64() {
fixnum!(Number, floor, arena)
if let Ok(value) = (&floor).try_into() {
fixnum!(Number, value, arena)
} else {
Number::Integer(arena_alloc!(floor, arena))
}
@@ -411,9 +399,9 @@ impl From<Fixnum> for Integer {
pub(crate) fn rnd_f(n: &Number) -> f64 {
match n {
&Number::Fixnum(n) => n.get_num() as f64,
&Number::Integer(ref n) => n.to_f64(),
&Number::Integer(ref n) => n.to_f64().value(),
&Number::Float(OrderedFloat(f)) => f,
&Number::Rational(ref r) => r.to_f64(),
&Number::Rational(ref r) => r.to_f64().value(),
}
}
@@ -433,7 +421,7 @@ fn classify_float(f: f64) -> Result<f64, EvalError> {
}
}
FpCategory::Nan => Err(EvalError::Undefined),
_ => Ok(f)
_ => Ok(f),
}
}
@@ -444,12 +432,12 @@ pub(crate) fn float_fn_to_f(n: i64) -> Result<f64, EvalError> {
#[inline]
pub(crate) fn float_i_to_f(n: &Integer) -> Result<f64, EvalError> {
classify_float(n.to_f64())
classify_float(n.to_f64().value())
}
#[inline]
pub(crate) fn float_r_to_f(r: &Rational) -> Result<f64, EvalError> {
classify_float(r.to_f64())
classify_float(r.to_f64().value())
}
#[inline]
@@ -541,15 +529,19 @@ impl PartialEq for Number {
fn eq(&self, rhs: &Self) -> bool {
match (self, rhs) {
(&Number::Fixnum(n1), &Number::Fixnum(n2)) => n1.eq(&n2),
(&Number::Fixnum(n1), &Number::Integer(ref n2)) => n1.get_num().eq(&**n2),
(&Number::Integer(ref n1), &Number::Fixnum(n2)) => (&**n1).eq(&n2.get_num()),
(&Number::Fixnum(n1), &Number::Rational(ref n2)) => n1.get_num().eq(&**n2),
(&Number::Rational(ref n1), &Number::Fixnum(n2)) => (&**n1).eq(&n2.get_num()),
(&Number::Fixnum(n1), &Number::Integer(ref n2)) => n1.get_num().num_eq(&**n2),
(&Number::Integer(ref n1), &Number::Fixnum(n2)) => (&**n1).num_eq(&n2.get_num()),
(&Number::Fixnum(n1), &Number::Rational(ref n2)) => Integer::from(n1.get_num()).num_eq(&**n2),
(&Number::Rational(ref n1), &Number::Fixnum(n2)) => (&**n1).num_eq(&Integer::from(n2.get_num())),
(&Number::Fixnum(n1), &Number::Float(n2)) => OrderedFloat(n1.get_num() as f64).eq(&n2),
(&Number::Float(n1), &Number::Fixnum(n2)) => n1.eq(&OrderedFloat(n2.get_num() as f64)),
(&Number::Integer(ref n1), &Number::Integer(ref n2)) => n1.eq(n2),
(&Number::Integer(ref n1), Number::Float(n2)) => OrderedFloat(n1.to_f64()).eq(n2),
(&Number::Float(n1), &Number::Integer(ref n2)) => n1.eq(&OrderedFloat(n2.to_f64())),
(&Number::Integer(ref n1), Number::Float(n2)) => {
OrderedFloat(n1.to_f64().value()).eq(n2)
}
(&Number::Float(n1), &Number::Integer(ref n2)) => {
n1.eq(&OrderedFloat(n2.to_f64().value()))
}
(&Number::Integer(ref n1), &Number::Rational(ref n2)) => {
#[cfg(feature = "num")]
{
@@ -557,7 +549,7 @@ impl PartialEq for Number {
}
#[cfg(not(feature = "num"))]
{
&**n1 == &**n2
(&**n1).num_eq(&**n2)
}
}
(&Number::Rational(ref n1), &Number::Integer(ref n2)) => {
@@ -567,11 +559,15 @@ impl PartialEq for Number {
}
#[cfg(not(feature = "num"))]
{
&**n1 == &**n2
(&**n1).num_eq(&**n2)
}
}
(&Number::Rational(ref n1), &Number::Float(n2)) => OrderedFloat(n1.to_f64()).eq(&n2),
(&Number::Float(n1), &Number::Rational(ref n2)) => n1.eq(&OrderedFloat(n2.to_f64())),
(&Number::Rational(ref n1), &Number::Float(n2)) => {
OrderedFloat(n1.to_f64().value()).eq(&n2)
}
(&Number::Float(n1), &Number::Rational(ref n2)) => {
n1.eq(&OrderedFloat(n2.to_f64().value()))
}
(&Number::Float(f1), &Number::Float(f2)) => f1.eq(&f2),
(&Number::Rational(ref r1), &Number::Rational(ref r2)) => r1.eq(&r2),
}
@@ -593,8 +589,8 @@ impl PartialOrd<usize> for Number {
(n as usize).partial_cmp(rhs)
}
}
Number::Integer(n) => (&**n).partial_cmp(rhs),
Number::Rational(r) => (&**r).partial_cmp(rhs),
Number::Integer(n) => Some((&**n).num_cmp(rhs)),
Number::Rational(r) => Some((&**r).num_cmp(&Integer::from(*rhs))),
Number::Float(f) => f.partial_cmp(&OrderedFloat(*rhs as f64)),
}
}
@@ -613,8 +609,8 @@ impl PartialEq<usize> for Number {
(n as usize).eq(rhs)
}
}
Number::Integer(n) => (&**n).eq(rhs),
Number::Rational(r) => (&**r).eq(rhs),
Number::Integer(n) => (&**n).num_eq(rhs),
Number::Rational(r) => (&**r).num_eq(&Integer::from(*rhs)),
Number::Float(f) => f.eq(&OrderedFloat(*rhs as f64)),
}
}
@@ -639,8 +635,10 @@ impl Ord for Number {
(&Number::Fixnum(n1), &Number::Float(n2)) => OrderedFloat(n1.get_num() as f64).cmp(&n2),
(&Number::Float(n1), &Number::Fixnum(n2)) => n1.cmp(&OrderedFloat(n2.get_num() as f64)),
(&Number::Integer(n1), &Number::Integer(n2)) => (*n1).cmp(&*n2),
(&Number::Integer(n1), Number::Float(n2)) => OrderedFloat(n1.to_f64()).cmp(n2),
(&Number::Float(n1), &Number::Integer(ref n2)) => n1.cmp(&OrderedFloat(n2.to_f64())),
(&Number::Integer(n1), Number::Float(n2)) => OrderedFloat(n1.to_f64().value()).cmp(n2),
(&Number::Float(n1), &Number::Integer(ref n2)) => {
n1.cmp(&OrderedFloat(n2.to_f64().value()))
}
(&Number::Integer(n1), &Number::Rational(n2)) => {
#[cfg(feature = "num")]
{
@@ -648,7 +646,7 @@ impl Ord for Number {
}
#[cfg(not(feature = "num"))]
{
(&*n1).partial_cmp(&*n2).unwrap_or(Ordering::Less)
(&*n1).num_partial_cmp(&*n2).unwrap_or(Ordering::Less)
}
}
(&Number::Rational(n1), &Number::Integer(n2)) => {
@@ -658,11 +656,15 @@ impl Ord for Number {
}
#[cfg(not(feature = "num"))]
{
(&*n1).partial_cmp(&*n2).unwrap_or(Ordering::Less)
(&*n1).num_partial_cmp(&*n2).unwrap_or(Ordering::Less)
}
}
(&Number::Rational(n1), &Number::Float(n2)) => OrderedFloat(n1.to_f64()).cmp(&n2),
(&Number::Float(n1), &Number::Rational(n2)) => n1.cmp(&OrderedFloat(n2.to_f64())),
(&Number::Rational(n1), &Number::Float(n2)) => {
OrderedFloat(n1.to_f64().value()).cmp(&n2)
}
(&Number::Float(n1), &Number::Rational(n2)) => {
n1.cmp(&OrderedFloat(n2.to_f64().value()))
}
(&Number::Float(f1), &Number::Float(f2)) => f1.cmp(&f2),
(&Number::Rational(r1), &Number::Rational(r2)) => (*r1).cmp(&*r2),
}
@@ -691,7 +693,7 @@ impl TryFrom<HeapCellValue> for Number {
(HeapCellValueTag::F64, n) => {
Ok(Number::Float(*n))
}
(HeapCellValueTag::Fixnum, n) => {
(HeapCellValueTag::Fixnum | HeapCellValueTag::CutPoint, n) => {
Ok(Number::Fixnum(n))
}
_ => {
@@ -703,20 +705,20 @@ impl TryFrom<HeapCellValue> for Number {
// Computes n ^ power. Ignores the sign of power.
pub(crate) fn binary_pow(mut n: Integer, power: &Integer) -> Integer {
let mut power = Integer::from(power.abs_ref());
let mut power = power.abs();
if power == 0 {
return Integer::from(1);
if power.is_zero() {
return Integer::ONE;
}
let mut oddand = Integer::from(1);
let mut oddand = Integer::ONE;
while power > 1 {
if power.is_odd() {
while power.num_gt(&1) {
if power.bit(0) {
oddand *= &n;
}
n.pow_assign(2);
n = n.pow(2);
power >>= 1;
}

View File

@@ -1,14 +1,19 @@
use crate::parser::ast::MAX_ARITY;
use crate::raw_block::*;
use crate::rcu::{Rcu, RcuRef};
use crate::types::*;
use std::borrow::Borrow;
use std::cmp::Ordering;
use std::hash::{Hash, Hasher};
use std::mem;
use std::ops::Deref;
use std::ptr;
use std::slice;
use std::str;
use std::sync::Arc;
use std::sync::Mutex;
use std::sync::RwLock;
use std::sync::Weak;
use indexmap::IndexSet;
@@ -16,7 +21,7 @@ use modular_bitfield::prelude::*;
#[derive(Copy, Clone, Debug, PartialEq, Eq)]
pub struct Atom {
pub index: usize,
pub index: u64,
}
const_assert!(mem::size_of::<Atom>() == 8);
@@ -33,46 +38,43 @@ impl<'a> From<&'a Atom> for Atom {
impl From<bool> for Atom {
#[inline]
fn from(value: bool) -> Self {
if value { atom!("true") } else { atom!("false") }
if value {
atom!("true")
} else {
atom!("false")
}
}
}
#[cfg(test)]
use std::cell::RefCell;
impl indexmap::Equivalent<Atom> for str {
fn equivalent(&self, key: &Atom) -> bool {
&*key.as_str() == self
}
}
const ATOM_TABLE_INIT_SIZE: usize = 1 << 16;
const ATOM_TABLE_ALIGN: usize = 8;
#[cfg(test)]
thread_local! {
static ATOM_TABLE_BUF_BASE: RefCell<*const u8> = RefCell::new(ptr::null_mut());
}
#[cfg(not(test))]
static mut ATOM_TABLE_BUF_BASE: *const u8 = ptr::null_mut();
#[cfg(test)]
fn set_atom_tbl_buf_base(ptr: *const u8) {
ATOM_TABLE_BUF_BASE.with(|atom_table_buf_base| {
*atom_table_buf_base.borrow_mut() = ptr;
});
}
#[cfg(test)]
pub(crate) fn get_atom_tbl_buf_base() -> *const u8 {
ATOM_TABLE_BUF_BASE.with(|atom_table_buf_base| *atom_table_buf_base.borrow())
}
#[cfg(not(test))]
fn set_atom_tbl_buf_base(ptr: *const u8) {
unsafe {
ATOM_TABLE_BUF_BASE = ptr;
#[inline(always)]
fn global_atom_table() -> &'static RwLock<Weak<AtomTable>> {
#[cfg(feature = "rust_beta_channel")]
{
// const Weak::new will be stabilized in 1.73 which is currently in beta,
// till then we need a OnceLock for initialization
static GLOBAL_ATOM_TABLE: RwLock<Weak<AtomTable>> = RwLock::const_new(Weak::new());
&GLOBAL_ATOM_TABLE
}
#[cfg(not(feature = "rust_beta_channel"))]
{
use std::sync::OnceLock;
static GLOBAL_ATOM_TABLE: OnceLock<RwLock<Weak<AtomTable>>> = OnceLock::new();
GLOBAL_ATOM_TABLE.get_or_init(|| RwLock::new(Weak::new()))
}
}
#[cfg(not(test))]
pub(crate) fn get_atom_tbl_buf_base() -> *const u8 {
unsafe { ATOM_TABLE_BUF_BASE }
#[inline(always)]
fn arc_atom_table() -> Option<Arc<AtomTable>> {
global_atom_table().read().unwrap().upgrade()
}
impl RawBlockTraits for AtomTable {
@@ -90,9 +92,11 @@ impl RawBlockTraits for AtomTable {
#[bitfield]
#[derive(Copy, Clone, Debug)]
struct AtomHeader {
#[allow(unused)] m: bool,
#[allow(unused)]
m: bool,
len: B50,
#[allow(unused)] padding: B13,
#[allow(unused)]
padding: B13,
}
impl AtomHeader {
@@ -101,13 +105,6 @@ impl AtomHeader {
}
}
impl Borrow<str> for Atom {
#[inline]
fn borrow(&self) -> &str {
self.as_str()
}
}
impl Hash for Atom {
#[inline]
fn hash<H: Hasher>(&self, hasher: &mut H) {
@@ -123,43 +120,92 @@ macro_rules! is_char {
};
}
impl Atom {
#[inline]
pub fn buf(self) -> *const u8 {
let ptr = self.as_ptr();
pub enum AtomString<'a> {
Static(&'a str),
Dynamic(AtomTableRef<str>),
}
if ptr.is_null() {
return ptr::null();
impl AtomString<'_> {
pub fn map<F>(self, f: F) -> Self
where
for<'a> F: FnOnce(&'a str) -> &'a str,
{
match self {
Self::Static(reference) => Self::Static(f(reference)),
Self::Dynamic(guard) => Self::Dynamic(AtomTableRef::map(guard, f)),
}
}
}
(ptr as usize + mem::size_of::<AtomHeader>()) as *const u8
impl std::fmt::Debug for AtomString<'_> {
fn fmt(&self, f: &mut std::fmt::Formatter) -> std::fmt::Result {
std::fmt::Debug::fmt(self.deref(), f)
}
}
impl std::fmt::Display for AtomString<'_> {
fn fmt(&self, f: &mut std::fmt::Formatter) -> std::fmt::Result {
std::fmt::Display::fmt(self.deref(), f)
}
}
impl std::ops::Deref for AtomString<'_> {
type Target = str;
fn deref(&self) -> &Self::Target {
match self {
Self::Static(reference) => reference,
Self::Dynamic(guard) => guard.deref(),
}
}
}
#[cfg(feature = "repl")]
impl rustyline::completion::Candidate for AtomString<'_> {
fn display(&self) -> &str {
self.deref()
}
fn replacement(&self) -> &str {
self.deref()
}
}
impl Atom {
#[inline(always)]
pub fn is_static(self) -> bool {
self.index < STRINGS.len() << 3
(self.index as usize) < STRINGS.len() << 3
}
#[inline(always)]
pub fn as_ptr(self) -> *const u8 {
pub fn as_ptr(self) -> Option<AtomTableRef<u8>> {
if self.is_static() {
ptr::null()
None
} else {
(get_atom_tbl_buf_base() as usize + self.index - (STRINGS.len() << 3)) as *const u8
let atom_table =
arc_atom_table().expect("We should only have an Atom while there is an AtomTable");
unsafe {
AtomTableRef::try_map(atom_table.buf(), |buf| {
(buf as *const u8)
.offset(((self.index as usize) - (STRINGS.len() << 3)) as isize)
.as_ref()
})
}
}
}
#[inline(always)]
pub fn from(index: usize) -> Self {
pub fn from(index: u64) -> Self {
Self { index }
}
#[inline(always)]
pub fn len(self) -> usize {
if self.is_static() {
STRINGS[self.index >> 3].len()
STRINGS[(self.index >> 3) as usize].len()
} else {
unsafe { ptr::read(self.as_ptr() as *const AtomHeader).len() as _ }
let ptr = self.as_ptr().unwrap();
let ptr = ptr.deref() as *const u8 as *const AtomHeader;
unsafe { ptr::read(ptr) }.len() as _
}
}
@@ -175,41 +221,44 @@ impl Atom {
let c1 = it.next();
let c2 = it.next();
if c2.is_none() { c1 } else { None }
}
#[inline]
pub fn chars(&self) -> str::Chars {
self.as_str().chars()
}
#[inline]
pub fn as_str(&self) -> &str {
unsafe {
let ptr = self.as_ptr();
if ptr.is_null() {
return STRINGS[self.index >> 3];
}
let header = ptr::read::<AtomHeader>(ptr as *const _);
let len = header.len() as usize;
let buf = (ptr as usize + mem::size_of::<AtomHeader>()) as *mut u8;
str::from_utf8_unchecked(slice::from_raw_parts(buf, len))
if c2.is_none() {
c1
} else {
None
}
}
pub fn defrock_brackets(&self, atom_tbl: &mut AtomTable) -> Self {
#[inline]
pub fn as_str(&self) -> AtomString<'static> {
if self.is_static() {
AtomString::Static(STRINGS[(self.index >> 3) as usize])
} else {
if let Some(ptr) = self.as_ptr() {
AtomString::Dynamic(AtomTableRef::map(ptr, |ptr| {
let header =
unsafe { ptr::read::<AtomHeader>(ptr as *const u8 as *const AtomHeader) };
let len = header.len() as usize;
let buf =
unsafe { (ptr as *const u8).offset(mem::size_of::<AtomHeader>() as isize) };
unsafe { str::from_utf8_unchecked(slice::from_raw_parts(buf, len)) }
}))
} else {
AtomString::Static(&STRINGS[(self.index >> 3) as usize])
}
}
}
pub fn defrock_brackets(&self, atom_tbl: &AtomTable) -> Self {
let s = self.as_str();
let s = if s.starts_with('(') && s.ends_with(')') {
let sub_str = if s.starts_with('(') && s.ends_with(')') {
&s['('.len_utf8()..s.len() - ')'.len_utf8()]
} else {
return *self;
};
atom_tbl.build_with(s)
AtomTable::build_with(&atom_tbl, &sub_str)
}
}
@@ -229,100 +278,156 @@ impl PartialOrd for Atom {
impl Ord for Atom {
#[inline]
fn cmp(&self, other: &Atom) -> Ordering {
self.as_str().cmp(other.as_str())
self.as_str().cmp(&*other.as_str())
}
}
#[derive(Debug)]
pub struct AtomTable {
pub struct InnerAtomTable {
block: RawBlock<AtomTable>,
pub table: IndexSet<Atom>,
pub table: Rcu<IndexSet<Atom>>,
}
impl Drop for AtomTable {
fn drop(&mut self) {
self.block.deallocate();
#[derive(Debug)]
pub struct AtomTable {
inner: Rcu<InnerAtomTable>,
// this lock is taking during resizing
update: Mutex<()>,
}
pub type AtomTableRef<M> = RcuRef<InnerAtomTable, M>;
impl InnerAtomTable {
#[inline(always)]
fn lookup_str(self: &InnerAtomTable, string: &str) -> Option<Atom> {
STATIC_ATOMS_MAP
.get(string)
.cloned()
.or_else(|| self.table.active_epoch().get(string).cloned())
}
}
impl AtomTable {
#[inline]
pub fn new() -> Self {
let table = Self {
block: RawBlock::new(),
table: IndexSet::new(),
};
set_atom_tbl_buf_base(table.block.base);
table
}
#[inline]
pub fn buf(&self) -> *const u8 {
self.block.base as *const u8
}
#[inline]
pub fn top(&self) -> *const u8 {
self.block.top
}
#[inline(always)]
fn lookup_str(&self, string: &str) -> Option<Atom> {
STATIC_ATOMS_MAP.get(string).or_else(|| self.table.get(string)).cloned()
}
pub fn build_with(&mut self, string: &str) -> Atom {
if let Some(atom) = self.lookup_str(string) {
return atom;
pub fn new() -> Arc<Self> {
let upgraded = global_atom_table().read().unwrap().upgrade();
// don't inline upgraded, otherwise temporary will be dropped too late in case of None
if let Some(atom_table) = upgraded {
atom_table
} else {
let mut guard = global_atom_table().write().unwrap();
// try to upgrade again in case we lost the race on the write lock
if let Some(atom_table) = guard.upgrade() {
atom_table
} else {
let atom_table = Arc::new(Self {
inner: Rcu::new(InnerAtomTable {
block: RawBlock::new(),
table: Rcu::new(IndexSet::new()),
}),
update: Mutex::new(()),
});
*guard = Arc::downgrade(&atom_table);
atom_table
}
}
}
#[inline]
pub fn buf(&self) -> AtomTableRef<u8> {
AtomTableRef::<InnerAtomTable>::map(self.inner.active_epoch(), |inner| {
unsafe { inner.block.base.as_ref() }.unwrap()
})
}
pub fn active_table(&self) -> RcuRef<IndexSet<Atom>, IndexSet<Atom>> {
self.inner.active_epoch().table.active_epoch()
}
pub fn build_with(atom_table: &AtomTable, string: &str) -> Atom {
loop {
let mut block_epoch = atom_table.inner.active_epoch();
let mut table_epoch = block_epoch.table.active_epoch();
if let Some(atom) = block_epoch.lookup_str(string) {
return atom;
}
// take a lock to prevent concurrent updates
let update_guard = atom_table.update.lock().unwrap();
let is_same_allocation =
RcuRef::same_epoch(&block_epoch, &atom_table.inner.active_epoch());
let is_same_atom_list =
RcuRef::same_epoch(&table_epoch, &block_epoch.table.active_epoch());
if !(is_same_allocation && is_same_atom_list) {
// some other thread raced us between our lookup and
// us aquring the update lock,
// try again
continue;
}
unsafe {
let size = mem::size_of::<AtomHeader>() + string.len();
let align_offset = 8 * mem::align_of::<AtomHeader>();
let size = (size & !(align_offset - 1)) + align_offset;
let len_ptr = {
let mut ptr;
loop {
ptr = self.block.alloc(size);
unsafe {
let len_ptr = loop {
let ptr = block_epoch.block.alloc(size);
if ptr.is_null() {
self.block.grow();
set_atom_tbl_buf_base(self.block.base);
// garbage collection would go here
let new_block = block_epoch.block.grow_new().unwrap();
let new_table = Rcu::new(table_epoch.clone());
let new_alloc = InnerAtomTable {
block: new_block,
table: new_table,
};
atom_table.inner.replace(new_alloc);
block_epoch = atom_table.inner.active_epoch();
table_epoch = block_epoch.table.active_epoch();
} else {
break;
break ptr;
}
}
};
ptr
};
let ptr_base = block_epoch.block.base as usize;
let ptr_base = self.block.base as usize;
write_to_ptr(string, len_ptr);
write_to_ptr(string, len_ptr);
let atom = Atom {
index: ((STRINGS.len() << 3) + len_ptr as usize - ptr_base) as u64,
};
let atom = Atom {
index: (STRINGS.len() << 3) + len_ptr as usize - ptr_base,
};
let mut table = table_epoch.clone();
table.insert(atom);
block_epoch.table.replace(table);
self.table.insert(atom);
// expicit drop to ensure we don't accidentally drop it early
drop(update_guard);
atom
return atom;
}
}
}
}
unsafe impl Send for AtomTable {}
unsafe impl Sync for AtomTable {}
#[bitfield]
#[repr(u64)]
#[derive(Copy, Clone, Debug)]
pub struct AtomCell {
name: B46,
arity: B10,
#[allow(unused)] f: bool,
#[allow(unused)] m: bool,
#[allow(unused)] tag: B6,
#[allow(unused)]
f: bool,
#[allow(unused)]
m: bool,
#[allow(unused)]
tag: B6,
}
impl AtomCell {
@@ -351,7 +456,7 @@ impl AtomCell {
#[inline]
pub fn get_name(self) -> Atom {
Atom::from(self.get_index() << 3)
Atom::from((self.get_index() as u64) << 3)
}
#[inline]
@@ -361,6 +466,6 @@ impl AtomCell {
#[inline]
pub fn get_name_and_arity(self) -> (Atom, usize) {
(Atom::from(self.get_index() << 3), self.get_arity())
(Atom::from((self.get_index() as u64) << 3), self.get_arity())
}
}

View File

@@ -1,11 +1,28 @@
fn main() {
use std::sync::atomic::Ordering;
fn main() -> std::process::ExitCode {
use scryer_prolog::*;
use scryer_prolog::atom_table::Atom;
use std::sync::atomic::Ordering;
#[cfg(feature = "repl")]
ctrlc::set_handler(move || {
scryer_prolog::machine::INTERRUPT.store(true, Ordering::Relaxed);
}).unwrap();
})
.unwrap();
let mut wam = machine::Machine::new();
wam.run_top_level();
#[cfg(target_arch = "wasm32")]
let runtime = tokio::runtime::Builder::new_current_thread()
.enable_all()
.build()
.unwrap();
#[cfg(not(target_arch = "wasm32"))]
let runtime = tokio::runtime::Builder::new_multi_thread()
.enable_all()
.build()
.unwrap();
runtime.block_on(async move {
let mut wam = machine::Machine::new(Default::default());
wam.run_top_level(atom!("$toplevel"), (atom!("$repl"), 1))
})
}

File diff suppressed because it is too large Load Diff

View File

@@ -1,42 +1,278 @@
use indexmap::IndexMap;
use crate::allocator::*;
use crate::fixtures::*;
use crate::codegen::SubsumedBranchHits;
use crate::forms::Level;
use crate::instructions::*;
use crate::machine::machine_indices::*;
use crate::machine::disjuncts::VarData;
use crate::parser::ast::*;
use crate::targets::CompilationTarget;
use crate::temp_v;
use crate::targets::*;
use crate::variable_records::*;
use bit_set::*;
use bitvec::prelude::*;
use fxhash::FxBuildHasher;
use indexmap::IndexMap;
use std::cell::Cell;
use std::collections::BTreeSet;
use std::rc::Rc;
use std::collections::VecDeque;
use std::ops::{Deref, DerefMut};
pub type BranchHits = IndexMap<usize, BitVec, FxBuildHasher>; // key: var_num, value: branch arm occurrences.
#[derive(Debug, Default)]
pub struct BranchOccurrences {
pub hits: BranchHits,
pub shallow_safety: BitSet<usize>, // unset means safe, set means unsafe (after the branch merge)
pub deep_safety: BitSet<usize>,
pub num_branches: usize,
pub current_branch: usize,
pub subsumed_hits: SubsumedBranchHits,
}
impl BranchOccurrences {
fn new(num_branches: usize) -> Self {
Self {
hits: BranchHits::with_hasher(FxBuildHasher::default()),
shallow_safety: BitSet::default(),
deep_safety: BitSet::default(),
num_branches,
current_branch: 0,
subsumed_hits: SubsumedBranchHits::with_hasher(FxBuildHasher::default()),
}
}
}
#[derive(Debug)]
pub(crate) struct BranchStack {
stack: Vec<BranchOccurrences>,
}
impl Deref for BranchStack {
type Target = Vec<BranchOccurrences>;
#[inline]
fn deref(&self) -> &Self::Target {
&self.stack
}
}
impl DerefMut for BranchStack {
#[inline]
fn deref_mut(&mut self) -> &mut Self::Target {
&mut self.stack
}
}
impl BranchStack {
fn branch_subsumes(&self, branch: &BranchDesignator, sub_branch: &BranchDesignator) -> bool {
if branch.branch_stack_num < sub_branch.branch_stack_num {
if branch.branch_stack_num == 0 {
true
} else {
let idx = branch.branch_stack_num - 1;
self[idx].current_branch == branch.branch_num
}
} else {
branch == sub_branch
}
}
fn safety_unneeded_in_branch(
&self,
safety: &VarSafetyStatus,
branch: &BranchDesignator,
) -> bool {
match safety {
VarSafetyStatus::Needed => false,
VarSafetyStatus::LocallyUnneeded(planter_branch) => {
self.branch_subsumes(planter_branch, branch)
}
VarSafetyStatus::GloballyUnneeded => true,
}
}
pub(crate) fn add_branch_occurrence(&mut self, var_num: usize) {
if let Some(occurrences) = self.last_mut() {
debug_assert!(occurrences.current_branch < occurrences.num_branches);
let num_branches = occurrences.num_branches;
let entry = occurrences
.hits
.entry(var_num)
.or_insert_with(|| BitVec::repeat(false, num_branches));
entry.set(occurrences.current_branch, true);
occurrences.subsumed_hits.insert(var_num);
}
}
pub(crate) fn add_branch_stack(&mut self, num_branches: usize) {
self.push(BranchOccurrences::new(num_branches));
}
pub(crate) fn current_branch_designator(&self) -> BranchDesignator {
let branch_stack_num = self.len();
let branch_num = self
.last()
.map(|occurrences| occurrences.current_branch)
.unwrap_or(0);
BranchDesignator {
branch_stack_num,
branch_num,
}
}
#[inline]
pub(crate) fn incr_current_branch(&mut self) {
let branch_occurrences = self.last_mut().unwrap();
branch_occurrences.current_branch += 1;
}
#[inline]
pub(crate) fn drain_branches(&mut self, depth: usize) -> std::vec::Drain<BranchOccurrences> {
let start_idx = self.len() - depth;
self.drain(start_idx..)
}
}
#[derive(Debug)]
pub(crate) struct DebrayAllocator {
bindings: IndexMap<Rc<String>, VarData, FxBuildHasher>,
pub(crate) var_data: VarData, // var_data replaces bindings.
pub(crate) branch_stack: BranchStack,
pub(crate) in_tail_position: bool,
arg_c: usize,
temp_lb: usize,
perm_lb: usize,
arity: usize, // 0 if not at head.
contents: IndexMap<usize, Rc<String>, FxBuildHasher>,
in_use: BTreeSet<usize>,
shallow_temp_mappings: IndexMap<usize, usize, FxBuildHasher>,
in_use: BitSet<usize>, // deep and non-var allocations
temp_free_list: Vec<usize>,
perm_free_list: VecDeque<(usize, usize)>, // chunk_num, var_num
}
impl DebrayAllocator {
fn is_curr_arg_distinct_from(&self, var: &String) -> bool {
match self.contents.get(&self.arg_c) {
Some(t_var) if **t_var != *var => true,
pub(crate) fn add_branch(&mut self) {
let branch_designator = self.branch_stack.current_branch_designator();
let subsumed_hits = {
let branch_occurrences = self.branch_stack.last_mut().unwrap();
std::mem::replace(
&mut branch_occurrences.subsumed_hits,
SubsumedBranchHits::with_hasher(FxBuildHasher::default()),
)
};
for var_num in subsumed_hits {
match &mut self.var_data.records[var_num].allocation {
VarAlloc::Perm(_, ref mut allocation) => {
match allocation {
PermVarAllocation::Done {
shallow_safety,
deep_safety,
..
} => {
if !self
.branch_stack
.safety_unneeded_in_branch(shallow_safety, &branch_designator)
{
let branch_occurrences = self.branch_stack.last_mut().unwrap();
branch_occurrences.shallow_safety.insert(var_num);
}
if !self
.branch_stack
.safety_unneeded_in_branch(deep_safety, &branch_designator)
{
let branch_occurrences = self.branch_stack.last_mut().unwrap();
branch_occurrences.deep_safety.insert(var_num);
}
}
_ => {
unreachable!();
}
}
*allocation = PermVarAllocation::Pending;
}
_ => unreachable!(),
}
}
}
pub(crate) fn pop_branch(&mut self, depth: usize, subsumed_hits: SubsumedBranchHits) {
let removed_branches = self.branch_stack.drain_branches(depth);
let (deep_safety, shallow_safety) = removed_branches.into_iter().fold(
(BitSet::default(), BitSet::default()),
|(mut deep_safety, mut shallow_safety), branch_occurrences| {
deep_safety.union_with(&branch_occurrences.deep_safety);
shallow_safety.union_with(&branch_occurrences.shallow_safety);
(deep_safety, shallow_safety)
},
);
let branch_designator = self.branch_stack.current_branch_designator();
let (deep_safety, shallow_safety) = match self.branch_stack.last_mut() {
Some(latest_branch) => {
latest_branch.deep_safety.union_with(&deep_safety);
latest_branch.shallow_safety.union_with(&shallow_safety);
(&latest_branch.deep_safety, &latest_branch.shallow_safety)
}
None => (&deep_safety, &shallow_safety),
};
for var_num in subsumed_hits.iter().cloned() {
let running_count = self.var_data.records[var_num].running_count;
let num_occurrences = self.var_data.records[var_num].num_occurrences;
match &mut self.var_data.records[var_num].allocation {
VarAlloc::Perm(_, allocation) => {
let shallow_safety = VarSafetyStatus::needed_if(
shallow_safety.contains(var_num),
branch_designator,
);
let deep_safety = VarSafetyStatus::needed_if(
deep_safety.contains(var_num),
branch_designator,
);
if running_count < num_occurrences {
*allocation = PermVarAllocation::Done {
shallow_safety,
deep_safety,
};
}
}
_ => unreachable!(),
}
}
if self.branch_stack.len() > 0 {
for var_num in subsumed_hits {
self.branch_stack.add_branch_occurrence(var_num);
}
}
}
fn is_curr_arg_distinct_from(&self, var_num: usize) -> bool {
match self.shallow_temp_mappings.get(&self.arg_c).cloned() {
Some(t_var) => t_var != var_num,
_ => false,
}
}
fn occurs_shallowly_in_head(&self, var: &String, r: usize) -> bool {
match self.bindings.get(var).unwrap() {
&VarData::Temp(_, _, ref tvd) => tvd.use_set.contains(&(GenContext::Head, r)),
fn occurs_shallowly_in_head(&self, var_num: usize, r: usize) -> bool {
match &self.var_data.records[var_num].allocation {
VarAlloc::Temp {
temp_var_data,
term_loc: GenContext::Head,
..
} => temp_var_data.use_set.contains(&(GenContext::Head, r)),
_ => false,
}
}
@@ -44,13 +280,13 @@ impl DebrayAllocator {
#[inline]
fn is_in_use(&self, r: usize) -> bool {
let in_use_range = r <= self.arity && r >= self.arg_c;
in_use_range || self.in_use.contains(&r)
in_use_range || self.in_use.contains(r)
}
fn alloc_with_cr(&self, var: &String) -> usize {
match self.bindings.get(var) {
Some(&VarData::Temp(_, _, ref tvd)) => {
for &(_, reg) in tvd.use_set.iter() {
fn alloc_with_cr(&self, var_num: usize) -> usize {
match &self.var_data.records[var_num].allocation {
VarAlloc::Temp { temp_var_data, .. } => {
for &(_, reg) in temp_var_data.use_set.iter() {
if !self.is_in_use(reg) {
return reg;
}
@@ -60,7 +296,7 @@ impl DebrayAllocator {
for reg in self.temp_lb.. {
if !self.is_in_use(reg) {
if !tvd.no_use_set.contains(&reg) {
if !temp_var_data.no_use_set.contains(reg) {
result = reg;
break;
}
@@ -73,10 +309,10 @@ impl DebrayAllocator {
}
}
fn alloc_with_ca(&self, var: &String) -> usize {
match self.bindings.get(var) {
Some(&VarData::Temp(_, _, ref tvd)) => {
for &(_, reg) in tvd.use_set.iter() {
fn alloc_with_ca(&self, var_num: usize) -> usize {
match &self.var_data.records[var_num].allocation {
VarAlloc::Temp { temp_var_data, .. } => {
for &(_, reg) in temp_var_data.use_set.iter() {
if !self.is_in_use(reg) {
return reg;
}
@@ -86,8 +322,8 @@ impl DebrayAllocator {
for reg in self.temp_lb.. {
if !self.is_in_use(reg) {
if !tvd.no_use_set.contains(&reg) {
if !tvd.conflict_set.contains(&reg) {
if !temp_var_data.no_use_set.contains(reg) {
if !temp_var_data.conflict_set.contains(reg) {
result = reg;
break;
}
@@ -101,23 +337,28 @@ impl DebrayAllocator {
}
}
fn alloc_in_last_goal_hint(&self, chunk_num: usize) -> Option<(Rc<String>, usize)> {
fn alloc_in_last_goal_hint(&self, chunk_num: usize) -> Option<(usize, usize)> {
// we want to allocate a register to the k^{th} parameter, par_k.
// par_k may not be a temporary variable.
let k = self.arg_c;
match self.contents.get(&k) {
match self.shallow_temp_mappings.get(&k).cloned() {
Some(t_var) => {
// suppose this branch fires. then t_var is a
// temp. var. belonging to the current chunk.
// consider its use set. T == par_k iff
// (GenContext::Last(_), k) is in t_var.use_set.
let tvd = self.bindings.get(t_var).unwrap();
if let &VarData::Temp(_, _, ref tvd) = tvd {
if !tvd.use_set.contains(&(GenContext::Last(chunk_num), k)) {
return Some((t_var.clone(), self.alloc_with_ca(t_var)));
match &self.var_data.records[t_var].allocation {
VarAlloc::Temp { temp_var_data, .. } => {
if !temp_var_data
.use_set
.contains(&(GenContext::Last(chunk_num), k))
{
return Some((t_var, self.alloc_with_ca(t_var)));
}
}
_ => {}
}
None
@@ -129,21 +370,23 @@ impl DebrayAllocator {
fn evacuate_arg<'a, Target: CompilationTarget<'a>>(
&mut self,
chunk_num: usize,
code: &mut Code,
code: &mut CodeDeque,
) {
match self.alloc_in_last_goal_hint(chunk_num) {
Some((var, r)) => {
Some((var_num, r)) => {
let k = self.arg_c;
if r != k {
let r = RegType::Temp(r);
code.push(Target::move_to_register(r, k));
code.push_back(Target::move_to_register(r, k));
self.contents.swap_remove(&k);
self.contents.insert(r.reg_num(), var.clone());
self.shallow_temp_mappings.swap_remove(&k);
self.shallow_temp_mappings.insert(r.reg_num(), var_num);
self.record_register(var, r);
self.var_data.records[var_num]
.allocation
.set_register(r.reg_num());
self.in_use.insert(r.reg_num());
}
}
@@ -153,27 +396,27 @@ impl DebrayAllocator {
fn alloc_reg_to_var<'a, Target: CompilationTarget<'a>>(
&mut self,
var: &String,
var_num: usize,
lvl: Level,
term_loc: GenContext,
target: &mut Vec<Instruction>,
target: &mut CodeDeque,
) -> usize {
match term_loc {
GenContext::Head => {
if let Level::Shallow = lvl {
self.evacuate_arg::<Target>(0, target);
self.alloc_with_cr(var)
self.alloc_with_cr(var_num)
} else {
self.alloc_with_ca(var)
self.alloc_with_ca(var_num)
}
}
GenContext::Mid(_) => self.alloc_with_ca(var),
GenContext::Mid(_) => self.alloc_with_ca(var_num),
GenContext::Last(chunk_num) => {
if let Level::Shallow = lvl {
self.evacuate_arg::<Target>(chunk_num, target);
self.alloc_with_cr(var)
self.alloc_with_cr(var_num)
} else {
self.alloc_with_ca(var)
self.alloc_with_ca(var_num)
}
}
}
@@ -182,38 +425,276 @@ impl DebrayAllocator {
fn alloc_reg_to_non_var(&mut self) -> usize {
let mut final_index = 0;
while let Some(r) = self.temp_free_list.pop() {
if !self.is_in_use(r) {
self.in_use.insert(r);
return r;
}
}
for index in self.temp_lb.. {
if !self.in_use.contains(&index) {
if !self.in_use.contains(index) {
final_index = index;
self.in_use.insert(final_index);
break;
}
}
self.in_use.insert(final_index);
self.temp_lb = final_index + 1;
final_index
}
fn in_place(&self, var: &String, term_loc: GenContext, r: RegType, k: usize) -> bool {
fn in_place(&self, var_num: usize, term_loc: GenContext, r: RegType, k: usize) -> bool {
match term_loc {
GenContext::Head if !r.is_perm() => r.reg_num() == k,
_ => match self.bindings().get(var).unwrap() {
&VarData::Temp(_, o, _) if r.reg_num() == k => o == k,
_ => match &self.var_data.records[var_num].allocation {
&VarAlloc::Temp { temp_reg, .. } if r.reg_num() == k => temp_reg == k,
_ => false,
},
}
}
fn alloc_perm_var(&mut self, var_num: usize, chunk_num: usize) -> usize {
let p = if let Some(p) = self.pop_free_perm(chunk_num) {
p
} else {
let p = self.perm_lb;
self.perm_lb += 1;
p
};
self.var_data.records[var_num].allocation = VarAlloc::Perm(p, PermVarAllocation::done());
p
}
pub(crate) fn add_reg_to_free_list(&mut self, r: RegType) {
if let RegType::Temp(r) = r {
self.in_use.remove(r);
self.temp_free_list.push(r);
}
}
pub fn reset_free_list(&mut self) {
self.temp_free_list.clear();
}
#[inline(always)]
pub fn get_binding(&self, var_num: usize) -> RegType {
self.var_data.records[var_num].allocation.as_reg_type()
}
pub fn num_perm_vars(&self) -> usize {
self.perm_lb - 1
}
pub fn increment_running_count(&mut self, var_num: usize) {
self.var_data.records[var_num].running_count += 1;
}
fn add_perm_to_free_list(&mut self, chunk_num: usize, var_num: usize) {
match &self.var_data.records[var_num].allocation {
VarAlloc::Perm(..) => {
self.perm_free_list.push_back((chunk_num, var_num));
}
_ => {}
}
}
fn pop_free_perm(&mut self, chunk_num: usize) -> Option<usize> {
while let Some((perm_chunk_num, var_num)) = self.perm_free_list.front().cloned() {
if chunk_num > perm_chunk_num {
self.perm_free_list.pop_front();
match &mut self.var_data.records[var_num].allocation {
VarAlloc::Perm(p, PermVarAllocation::Pending) if *p > 0 => {
return Some(std::mem::replace(p, 0));
}
_ => {}
}
} else {
return None;
}
}
None
}
pub(crate) fn free_var(&mut self, chunk_num: usize, var_num: usize) {
match &mut self.var_data.records[var_num].allocation {
VarAlloc::Perm(_, allocation) => {
*allocation = PermVarAllocation::Pending;
self.add_perm_to_free_list(chunk_num, var_num);
}
_ => {}
}
}
pub(crate) fn mark_safe_var_unconditionally(&mut self, var_num: usize) {
let branch_designator = self.branch_stack.current_branch_designator();
match &mut self.var_data.records[var_num].allocation {
VarAlloc::Perm(
_,
PermVarAllocation::Done {
deep_safety,
shallow_safety,
..
},
) => {
*deep_safety = VarSafetyStatus::unneeded(branch_designator);
*shallow_safety = VarSafetyStatus::unneeded(branch_designator);
}
VarAlloc::Temp { safety, .. } => {
*safety = VarSafetyStatus::unneeded(branch_designator);
}
_ => unreachable!(),
}
}
fn mark_safe_var(&mut self, var_num: usize, lvl: Level, term_loc: GenContext) {
let branch_designator = self.branch_stack.current_branch_designator();
match &mut self.var_data.records[var_num].allocation {
VarAlloc::Perm(
_,
PermVarAllocation::Done {
deep_safety,
shallow_safety,
..
},
) => {
// GetVariable in head chunk is considered safe.
if lvl == Level::Deep {
*deep_safety = VarSafetyStatus::unneeded(branch_designator);
*shallow_safety = VarSafetyStatus::unneeded(branch_designator);
} else if term_loc == GenContext::Head {
*shallow_safety = VarSafetyStatus::GloballyUnneeded;
} else {
if let Some(temp_var_num) = self.shallow_temp_mappings.get(&self.arg_c).cloned()
{
match &mut self.var_data.records[temp_var_num].allocation {
VarAlloc::Temp {
ref mut to_perm_var_num,
..
} => {
*to_perm_var_num = Some(var_num);
}
_ => unreachable!(),
}
}
}
}
VarAlloc::Temp { ref mut safety, .. } => {
*safety = VarSafetyStatus::GloballyUnneeded;
}
_ => {
unreachable!()
}
}
}
fn argument_to_value<'a, Target: CompilationTarget<'a>>(
&mut self,
var_num: usize,
r: RegType,
arg_c: usize,
) -> Instruction {
let branch_designator = self.branch_stack.current_branch_designator();
match &mut self.var_data.records[var_num].allocation {
VarAlloc::Perm(
_,
PermVarAllocation::Done {
ref mut shallow_safety,
..
},
) => {
if !self.in_tail_position
|| self
.branch_stack
.safety_unneeded_in_branch(shallow_safety, &branch_designator)
{
Target::argument_to_value(r, arg_c)
} else {
*shallow_safety = VarSafetyStatus::unneeded(branch_designator);
Target::unsafe_argument_to_value(r, arg_c)
}
}
VarAlloc::Temp { ref mut safety, .. } => {
if self
.branch_stack
.safety_unneeded_in_branch(safety, &branch_designator)
{
Target::argument_to_value(r, arg_c)
} else {
*safety = VarSafetyStatus::GloballyUnneeded;
Target::unsafe_argument_to_value(r, arg_c)
}
}
_ => {
unreachable!()
}
}
}
fn subterm_to_value<'a, Target: CompilationTarget<'a>>(
&mut self,
var_num: usize,
r: RegType,
) -> Instruction {
let branch_designator = self.branch_stack.current_branch_designator();
match &mut self.var_data.records[var_num].allocation {
VarAlloc::Perm(
_,
PermVarAllocation::Done {
ref mut deep_safety,
..
},
) => {
if self
.branch_stack
.safety_unneeded_in_branch(deep_safety, &branch_designator)
{
Target::subterm_to_value(r)
} else {
*deep_safety = VarSafetyStatus::unneeded(branch_designator);
Target::unsafe_subterm_to_value(r)
}
}
VarAlloc::Temp { ref mut safety, .. } => {
if self
.branch_stack
.safety_unneeded_in_branch(safety, &branch_designator)
{
Target::subterm_to_value(r)
} else {
*safety = VarSafetyStatus::unneeded(branch_designator);
Target::unsafe_subterm_to_value(r)
}
}
_ => {
unreachable!()
}
}
}
}
impl Allocator for DebrayAllocator {
fn new() -> DebrayAllocator {
DebrayAllocator {
Self {
var_data: VarData::default(),
in_tail_position: false,
arity: 0,
arg_c: 1,
temp_lb: 1,
bindings: IndexMap::with_hasher(FxBuildHasher::default()),
contents: IndexMap::with_hasher(FxBuildHasher::default()),
in_use: BTreeSet::new(),
perm_lb: 1,
shallow_temp_mappings: IndexMap::with_hasher(FxBuildHasher::default()),
in_use: BitSet::default(),
temp_free_list: vec![],
perm_free_list: VecDeque::new(),
branch_stack: BranchStack { stack: vec![] },
}
}
@@ -221,12 +702,12 @@ impl Allocator for DebrayAllocator {
&mut self,
lvl: Level,
term_loc: GenContext,
code: &mut Code,
code: &mut CodeDeque,
) {
let r = RegType::Temp(self.alloc_reg_to_non_var());
match lvl {
Level::Deep => code.push(Target::subterm_to_variable(r)),
Level::Deep => code.push_back(Target::subterm_to_variable(r)),
Level::Root | Level::Shallow => {
let k = self.arg_c;
@@ -236,7 +717,7 @@ impl Allocator for DebrayAllocator {
self.arg_c += 1;
code.push(Target::argument_to_variable(r, k));
code.push_back(Target::argument_to_variable(r, k));
}
};
}
@@ -246,7 +727,7 @@ impl Allocator for DebrayAllocator {
lvl: Level,
term_loc: GenContext,
cell: &'a Cell<RegType>,
code: &mut Code,
code: &mut CodeDeque,
) {
let r = cell.get();
@@ -273,39 +754,51 @@ impl Allocator for DebrayAllocator {
fn mark_var<'a, Target: CompilationTarget<'a>>(
&mut self,
var: Rc<String>,
var_num: usize,
lvl: Level,
cell: &'a Cell<VarReg>,
term_loc: GenContext,
code: &mut Code,
code: &mut CodeDeque,
) {
let (r, is_new_var) = match self.get(var.clone()) {
let (r, is_new_var) = match self.get_binding(var_num) {
RegType::Temp(0) => {
// here, r is temporary *and* unassigned.
let o = self.alloc_reg_to_var::<Target>(&var, lvl, term_loc, code);
let o = self.alloc_reg_to_var::<Target>(var_num, lvl, term_loc, code);
cell.set(VarReg::Norm(RegType::Temp(o)));
(RegType::Temp(o), true)
}
RegType::Perm(0) => {
let pr = cell.get().norm();
self.record_register(var.clone(), pr);
let p = self.alloc_perm_var(var_num, term_loc.chunk_num());
(RegType::Perm(p), true)
}
r @ RegType::Perm(_) => {
let is_new_var = match &mut self.var_data.records[var_num].allocation {
VarAlloc::Perm(_, allocation) => {
if allocation.pending() {
*allocation = PermVarAllocation::done();
true
} else {
false
}
}
_ => unreachable!(),
};
(pr, true)
(r, is_new_var)
}
r => (r, false),
};
self.mark_reserved_var::<Target>(var, lvl, cell, term_loc, code, r, is_new_var);
self.mark_reserved_var::<Target>(var_num, lvl, cell, term_loc, code, r, is_new_var);
}
fn mark_reserved_var<'a, Target: CompilationTarget<'a>>(
&mut self,
var: Rc<String>,
var_num: usize,
lvl: Level,
cell: &'a Cell<VarReg>,
term_loc: GenContext,
code: &mut Code,
code: &mut CodeDeque,
r: RegType,
is_new_var: bool,
) {
@@ -313,84 +806,101 @@ impl Allocator for DebrayAllocator {
Level::Root | Level::Shallow => {
let k = self.arg_c;
if self.is_curr_arg_distinct_from(&var) {
if self.is_curr_arg_distinct_from(var_num) {
self.evacuate_arg::<Target>(term_loc.chunk_num(), code);
}
self.arg_c += 1;
cell.set(VarReg::ArgAndNorm(r, k));
if !self.in_place(&var, term_loc, r, k) {
if !self.in_place(var_num, term_loc, r, k) {
if is_new_var {
code.push(Target::argument_to_variable(r, k));
self.mark_safe_var(var_num, lvl, term_loc);
code.push_back(Target::argument_to_variable(r, k));
} else {
code.push(Target::argument_to_value(r, k));
code.push_back(self.argument_to_value::<Target>(var_num, r, k));
}
}
self.arg_c += 1;
}
Level::Deep if is_new_var => {
if let GenContext::Head = term_loc {
if self.occurs_shallowly_in_head(&var, r.reg_num()) {
code.push(Target::subterm_to_value(r));
if self.occurs_shallowly_in_head(var_num, r.reg_num()) {
code.push_back(self.subterm_to_value::<Target>(var_num, r));
} else {
code.push(Target::subterm_to_variable(r));
self.mark_safe_var(var_num, lvl, term_loc);
code.push_back(Target::subterm_to_variable(r));
}
} else {
code.push(Target::subterm_to_variable(r));
self.mark_safe_var(var_num, lvl, term_loc);
code.push_back(Target::subterm_to_variable(r));
}
}
Level::Deep => code.push(Target::subterm_to_value(r)),
};
Level::Deep => code.push_back(self.subterm_to_value::<Target>(var_num, r)),
}
let o = r.reg_num();
if !r.is_perm() {
let o = r.reg_num();
self.shallow_temp_mappings.insert(o, var_num);
} else if r.is_perm() && is_new_var {
self.branch_stack.add_branch_occurrence(var_num);
}
self.contents.insert(o, var.clone());
self.record_register(var.clone(), r);
self.in_use.insert(o);
let record = &mut self.var_data.records[var_num];
record.allocation.set_register(o);
if record.running_count < record.num_occurrences {
record.running_count += 1;
} else {
self.free_var(term_loc.chunk_num(), var_num);
}
self.in_use.insert(o);
}
fn mark_cut_var(&mut self, var_num: usize, chunk_num: usize) -> RegType {
match self.get_binding(var_num) {
RegType::Perm(0) | RegType::Temp(0) => {
RegType::Perm(self.alloc_perm_var(var_num, chunk_num))
}
r => r,
}
}
fn reset(&mut self) {
self.bindings.clear();
self.contents.clear();
self.perm_lb = 1;
self.shallow_temp_mappings.clear();
self.in_use.clear();
self.temp_free_list.clear();
}
fn reset_contents(&mut self) {
self.contents.clear();
self.in_use.clear();
self.shallow_temp_mappings.clear();
self.temp_free_list.clear();
}
fn advance_arg(&mut self) {
self.arg_c += 1;
}
fn bindings(&self) -> &AllocVarDict {
&self.bindings
}
fn bindings_mut(&mut self) -> &mut AllocVarDict {
&mut self.bindings
}
fn take_bindings(self) -> AllocVarDict {
self.bindings
}
fn reset_at_head(&mut self, args: &Vec<Term>) {
self.reset_arg(args.len());
self.arity = args.len();
for (idx, arg) in args.iter().enumerate() {
if let &Term::Var(_, ref var) = arg {
let r = self.get(var.clone());
let var_num = var.to_var_num().unwrap();
let r = self.get_binding(var_num);
if !r.is_perm() && r.reg_num() == 0 {
self.in_use.insert(idx + 1);
self.contents.insert(idx + 1, var.clone());
self.record_register(var.clone(), temp_v!(idx + 1));
self.shallow_temp_mappings.insert(idx + 1, var_num);
self.var_data.records[var_num]
.allocation
.set_register(idx + 1);
}
}
}

499
src/ffi.rs Normal file
View File

@@ -0,0 +1,499 @@
/* How does FFI work?
Each WAM machine has a ForeignFunctionTable instance that contains a table of functions and structs.
Structs are defined via foreign_struct/2. Basic types are defined by libffi, but struct types need to
be manually defined to get an ffi_type. Additionally, to recover structs from return arguments, we store
fields and atom_fields, as a way to lookup the content of the struct (fields) and the nested structs (atom_fields).
Functions are defined via use_foreign_module/2. It opens a library and leaks the memory of the library,
to prevent Rust freeing the memory. There's no way to recover that memory at the moment. We get a pointer for
each function and we build a CIF for each one, with the input arguments and the return argument.
Exec happens via '$foreign_call', we find the function, we try to cast the values that we have to the definition
of the function, we reserve memory for them and we build an array of pointers. To get the return argument, we
reserve enough memory for the return and we build the Scryer values from them.
Structs are a bit tricky as they need to be aligned. For that, we reserve enough memory (libffi calculates that)
and for each field: we add to the pointer until we're aligned to the next data type we're going to write, we write it,
and finally we add the pointer the size of what we've written.
*/
use crate::atom_table::Atom;
use std::alloc::{alloc, Layout};
use std::any::Any;
use std::collections::HashMap;
use std::convert::TryFrom;
use std::error::Error;
use std::ffi::{c_void, CString};
use libffi::low::{ffi_abi_FFI_DEFAULT_ABI, ffi_cif, ffi_type, prep_cif, type_tag, types, CodePtr};
use libloading::{Library, Symbol};
pub struct FunctionDefinition {
pub name: String,
pub return_value: Atom,
pub args: Vec<Atom>,
}
#[derive(Debug)]
pub struct FunctionImpl {
cif: ffi_cif,
args: Vec<*mut ffi_type>,
code_ptr: CodePtr,
return_struct_name: Option<String>,
}
#[derive(Debug, Default)]
pub struct ForeignFunctionTable {
table: HashMap<String, FunctionImpl>,
structs: HashMap<String, StructImpl>,
}
#[derive(Debug, Clone)]
struct StructImpl {
ffi_type: ffi_type,
fields: Vec<*mut ffi_type>,
atom_fields: Vec<Atom>,
}
struct PointerArgs {
pointers: Vec<*mut c_void>,
_memory: Vec<Box<dyn Any>>,
}
impl ForeignFunctionTable {
pub fn merge(&mut self, other: ForeignFunctionTable) {
self.table.extend(other.table);
}
pub fn define_struct(&mut self, name: &str, atom_fields: Vec<Atom>) {
let mut fields: Vec<_> = atom_fields.iter().map(|x| self.map_type_ffi(&x)).collect();
fields.push(std::ptr::null_mut::<ffi_type>());
let mut struct_type: ffi_type = Default::default();
struct_type.type_ = type_tag::STRUCT;
struct_type.elements = fields.as_mut_ptr();
self.structs.insert(
name.to_string(),
StructImpl {
ffi_type: struct_type,
fields,
atom_fields,
},
);
}
fn map_type_ffi(&mut self, source: &Atom) -> *mut ffi_type {
unsafe {
match source {
atom!("sint64") => &mut types::sint64,
atom!("sint32") => &mut types::sint32,
atom!("sint16") => &mut types::sint16,
atom!("sint8") => &mut types::sint8,
atom!("uint64") => &mut types::uint64,
atom!("uint32") => &mut types::uint32,
atom!("uint16") => &mut types::uint16,
atom!("uint8") => &mut types::uint8,
atom!("bool") => &mut types::sint8,
atom!("void") => &mut types::void,
atom!("cstr") => &mut types::pointer,
atom!("ptr") => &mut types::pointer,
atom!("f32") => &mut types::float,
atom!("f64") => &mut types::double,
struct_name => match self.structs.get_mut(&*struct_name.as_str()) {
Some(ref mut struct_type) => &mut struct_type.ffi_type,
None => unreachable!(),
},
}
}
}
pub(crate) fn load_library(
&mut self,
library_name: &str,
functions: &Vec<FunctionDefinition>,
) -> Result<(), Box<dyn Error>> {
let mut ff_table: ForeignFunctionTable = Default::default();
unsafe {
let library = Library::new(library_name)?;
for function in functions {
let symbol_name: CString = CString::new(function.name.clone())?;
let code_ptr: Symbol<*mut c_void> =
library.get(&symbol_name.into_bytes_with_nul())?;
let mut args: Vec<_> = function
.args
.iter()
.map(|x| self.map_type_ffi(&x))
.collect();
let mut cif: ffi_cif = Default::default();
prep_cif(
&mut cif,
ffi_abi_FFI_DEFAULT_ABI,
args.len(),
self.map_type_ffi(&function.return_value),
args.as_mut_ptr(),
)
.unwrap();
let return_struct_name = if (*self.map_type_ffi(&function.return_value)).type_
as u32
== libffi::raw::FFI_TYPE_STRUCT
{
Some(function.return_value.as_str().to_string())
} else {
None
};
ff_table.table.insert(
function.name.clone(),
FunctionImpl {
cif,
args,
code_ptr: CodePtr(code_ptr.into_raw().into_raw() as *mut _),
return_struct_name,
},
);
}
std::mem::forget(library);
}
self.merge(ff_table);
Ok(())
}
fn build_pointer_args(
args: &mut Vec<Value>,
type_args: &Vec<*mut ffi_type>,
structs_table: &mut HashMap<String, StructImpl>,
) -> Result<PointerArgs, FFIError> {
let mut pointers = Vec::with_capacity(args.len());
let mut _memory = Vec::new();
for i in 0..args.len() {
let field_type = type_args[i];
unsafe {
macro_rules! push_int {
($type:ty) => {{
let n: $type = <$type>::try_from(args[i].as_int()?)
.map_err(|_| FFIError::ValueDontFit)?;
let mut box_value = Box::new(n) as Box<dyn Any>;
pointers.push(&mut *box_value as *mut _ as *mut c_void);
_memory.push(box_value);
}};
}
match (*field_type).type_ as u32 {
libffi::raw::FFI_TYPE_UINT8 => push_int!(u8),
libffi::raw::FFI_TYPE_SINT8 => push_int!(i8),
libffi::raw::FFI_TYPE_UINT16 => push_int!(u16),
libffi::raw::FFI_TYPE_SINT16 => push_int!(i16),
libffi::raw::FFI_TYPE_UINT32 => push_int!(u32),
libffi::raw::FFI_TYPE_SINT32 => push_int!(i32),
libffi::raw::FFI_TYPE_UINT64 => push_int!(u64),
libffi::raw::FFI_TYPE_SINT64 => push_int!(i64),
libffi::raw::FFI_TYPE_FLOAT => {
let n: f32 = args[i].as_float()? as f32;
let mut box_value = Box::new(n) as Box<dyn Any>;
pointers.push(&mut *box_value as *mut _ as *mut c_void);
_memory.push(box_value);
}
libffi::raw::FFI_TYPE_DOUBLE => {
let n: f64 = args[i].as_float()?;
let mut box_value = Box::new(n) as Box<dyn Any>;
pointers.push(&mut *box_value as *mut _ as *mut c_void);
_memory.push(box_value);
}
libffi::raw::FFI_TYPE_POINTER => {
let ptr: *mut c_void = args[i].as_ptr()?;
pointers.push(ptr);
}
libffi::raw::FFI_TYPE_STRUCT => {
let (mut ptr, _size, _align) =
Self::build_struct(&mut args[i], structs_table)?;
pointers.push(&mut *ptr as *mut _ as *mut c_void);
_memory.push(ptr);
}
_ => return Err(FFIError::InvalidFFIType),
}
}
}
Ok(PointerArgs { pointers, _memory })
}
fn build_struct(
arg: &mut Value,
structs_table: &mut HashMap<String, StructImpl>,
) -> Result<(Box<dyn Any>, usize, usize), FFIError> {
unsafe {
match arg {
Value::Struct(ref name, ref mut struct_args) => {
if let Some(ref mut struct_type) = structs_table.clone().get_mut(name) {
let layout = Layout::from_size_align(
struct_type.ffi_type.size,
struct_type.ffi_type.alignment.into(),
)
.unwrap();
let align = struct_type.ffi_type.alignment as usize;
let size = struct_type.ffi_type.size;
let ptr = alloc(layout) as *mut c_void;
let mut field_ptr = ptr;
for i in 0..(struct_type.fields.len() - 1) {
macro_rules! try_write_int {
($type:ty) => {{
field_ptr = field_ptr
.add(field_ptr.align_offset(std::mem::align_of::<$type>()));
let n: $type = <$type>::try_from(struct_args[i].as_int()?)
.map_err(|_| FFIError::ValueDontFit)?;
std::ptr::write(field_ptr as *mut $type, n);
field_ptr = field_ptr.add(std::mem::size_of::<$type>());
}};
}
macro_rules! write {
($type:ty, $value:expr) => {{
let data: $type = $value;
std::ptr::write(field_ptr as *mut $type, data);
field_ptr = field_ptr.add(align);
}};
}
let field = struct_type.fields[i];
match (*field).type_ as u32 {
libffi::raw::FFI_TYPE_UINT8 => try_write_int!(u8),
libffi::raw::FFI_TYPE_SINT8 => try_write_int!(i8),
libffi::raw::FFI_TYPE_UINT16 => try_write_int!(u16),
libffi::raw::FFI_TYPE_SINT16 => try_write_int!(i16),
libffi::raw::FFI_TYPE_UINT32 => try_write_int!(u32),
libffi::raw::FFI_TYPE_SINT32 => try_write_int!(i32),
libffi::raw::FFI_TYPE_UINT64 => try_write_int!(u64),
libffi::raw::FFI_TYPE_SINT64 => try_write_int!(i64),
libffi::raw::FFI_TYPE_POINTER => {
write!(*mut c_void, struct_args[i].as_ptr()?)
}
libffi::raw::FFI_TYPE_FLOAT => {
write!(f32, struct_args[i].as_float()? as f32)
}
libffi::raw::FFI_TYPE_DOUBLE => {
write!(f64, struct_args[i].as_float()?)
}
libffi::raw::FFI_TYPE_STRUCT => {
let (struct_ptr, struct_size, struct_align) =
Self::build_struct(&mut struct_args[i], structs_table)?;
field_ptr = field_ptr.add(field_ptr.align_offset(struct_align));
std::ptr::copy(
&*struct_ptr as *const _ as *const c_void,
field_ptr as *mut c_void,
struct_size,
);
field_ptr = field_ptr.add(struct_size);
}
_ => {
unreachable!()
}
}
}
return Ok((Box::from_raw(ptr), size, align));
} else {
return Err(FFIError::InvalidStructName);
}
}
_ => return Err(FFIError::ValueCast),
}
}
}
pub fn exec(&mut self, name: &str, mut args: Vec<Value>) -> Result<Value, FFIError> {
let function_impl = self.table.get_mut(name).ok_or(FFIError::FunctionNotFound)?;
let mut pointer_args =
Self::build_pointer_args(&mut args, &function_impl.args, &mut self.structs)?;
return unsafe {
macro_rules! call_and_return {
($type:ty) => {{
let mut n: Box<u8> = Box::new(0);
libffi::raw::ffi_call(
&mut function_impl.cif,
Some(*function_impl.code_ptr.as_safe_fun()),
&mut *n as *mut _ as *mut c_void,
pointer_args.pointers.as_mut_ptr() as *mut *mut c_void,
);
Ok(Value::Int(i64::from(*n)))
}};
}
match (*function_impl.cif.rtype).type_ as u32 {
libffi::raw::FFI_TYPE_VOID => call_and_return!(i32),
libffi::raw::FFI_TYPE_UINT8 => call_and_return!(u8),
libffi::raw::FFI_TYPE_SINT8 => call_and_return!(i8),
libffi::raw::FFI_TYPE_UINT16 => call_and_return!(u16),
libffi::raw::FFI_TYPE_SINT16 => call_and_return!(i16),
libffi::raw::FFI_TYPE_UINT32 => call_and_return!(u32),
libffi::raw::FFI_TYPE_SINT32 => call_and_return!(i32),
libffi::raw::FFI_TYPE_UINT64 => {
let mut n: Box<u64> = Box::new(0);
libffi::raw::ffi_call(
&mut function_impl.cif,
Some(*function_impl.code_ptr.as_safe_fun()),
&mut *n as *mut _ as *mut c_void,
pointer_args.pointers.as_mut_ptr() as *mut *mut c_void,
);
Ok(Value::Int(
i64::try_from(*n).map_err(|_| FFIError::ValueDontFit)?,
))
}
libffi::raw::FFI_TYPE_SINT64 => call_and_return!(i64),
libffi::raw::FFI_TYPE_POINTER => call_and_return!(*mut c_void),
libffi::raw::FFI_TYPE_FLOAT => {
let mut n: Box<f32> = Box::new(0.0);
libffi::raw::ffi_call(
&mut function_impl.cif,
Some(*function_impl.code_ptr.as_safe_fun()),
&mut *n as *mut _ as *mut c_void,
pointer_args.pointers.as_mut_ptr() as *mut *mut c_void,
);
Ok(Value::Float((*n).into()))
}
libffi::raw::FFI_TYPE_DOUBLE => {
let mut n: Box<f64> = Box::new(0.0);
libffi::raw::ffi_call(
&mut function_impl.cif,
Some(*function_impl.code_ptr.as_safe_fun()),
&mut *n as *mut _ as *mut c_void,
pointer_args.pointers.as_mut_ptr() as *mut *mut c_void,
);
Ok(Value::Float(*n))
}
libffi::raw::FFI_TYPE_STRUCT => {
let name = &function_impl
.return_struct_name
.clone()
.ok_or(FFIError::StructNotFound)?;
let struct_type = self.structs.get(name).ok_or(FFIError::StructNotFound)?;
let layout = Layout::from_size_align(
struct_type.ffi_type.size,
struct_type.ffi_type.alignment.into(),
)
.unwrap();
let ptr = alloc(layout) as *mut c_void;
libffi::raw::ffi_call(
&mut function_impl.cif,
Some(*function_impl.code_ptr.as_safe_fun()),
&mut *ptr as *mut _ as *mut c_void,
pointer_args.pointers.as_mut_ptr() as *mut *mut c_void,
);
let struct_val = self.read_struct(ptr, name, struct_type);
drop(Box::from_raw(ptr));
struct_val
}
_ => unreachable!(),
}
};
}
fn read_struct(
&self,
ptr: *mut c_void,
name: &str,
struct_type: &StructImpl,
) -> Result<Value, FFIError> {
unsafe {
let mut returns = Vec::new();
let mut field_ptr = ptr;
for i in 0..(struct_type.fields.len() - 1) {
let field = struct_type.fields[i];
macro_rules! read_and_push_int {
($type:ty) => {{
field_ptr =
field_ptr.add(field_ptr.align_offset(std::mem::align_of::<$type>()));
let n = std::ptr::read(field_ptr as *mut $type);
returns.push(Value::Int(i64::from(n)));
field_ptr = field_ptr.add(std::mem::size_of::<$type>());
}};
}
match (*field).type_ as u32 {
libffi::raw::FFI_TYPE_UINT8 => read_and_push_int!(u8),
libffi::raw::FFI_TYPE_SINT8 => read_and_push_int!(i8),
libffi::raw::FFI_TYPE_UINT16 => read_and_push_int!(u16),
libffi::raw::FFI_TYPE_SINT16 => read_and_push_int!(i16),
libffi::raw::FFI_TYPE_UINT32 => read_and_push_int!(u32),
libffi::raw::FFI_TYPE_SINT32 => read_and_push_int!(i32),
libffi::raw::FFI_TYPE_UINT64 => {
field_ptr =
field_ptr.add(field_ptr.align_offset(std::mem::align_of::<u64>()));
let n = std::ptr::read(field_ptr as *mut u64);
returns.push(Value::Int(
i64::try_from(n).map_err(|_| FFIError::ValueDontFit)?,
));
field_ptr = field_ptr.add(std::mem::size_of::<u64>());
}
libffi::raw::FFI_TYPE_SINT64 => read_and_push_int!(i64),
libffi::raw::FFI_TYPE_POINTER => read_and_push_int!(i64),
libffi::raw::FFI_TYPE_STRUCT => {
let substruct = struct_type.atom_fields[i].as_str();
let struct_type = self
.structs
.get(&*substruct)
.ok_or(FFIError::StructNotFound)?;
field_ptr = field_ptr
.add(field_ptr.align_offset(struct_type.ffi_type.alignment as usize));
let struct_val = self.read_struct(field_ptr, &*substruct, struct_type);
returns.push(struct_val?);
field_ptr = field_ptr.add(struct_type.ffi_type.size);
}
_ => {
unreachable!()
}
}
}
Ok(Value::Struct(name.into(), returns))
}
}
}
#[derive(Clone, Debug)]
pub enum Value {
Int(i64),
Float(f64),
CString(CString),
Struct(String, Vec<Value>),
}
impl Value {
fn as_int(&self) -> Result<i64, FFIError> {
match self {
Value::Int(n) => Ok(*n),
_ => Err(FFIError::ValueCast),
}
}
fn as_float(&self) -> Result<f64, FFIError> {
match self {
Value::Float(n) => Ok(*n),
Value::Int(n) => Ok(*n as f64),
_ => Err(FFIError::ValueCast),
}
}
fn as_ptr(&mut self) -> Result<*mut c_void, FFIError> {
match self {
Value::CString(ref mut cstr) => Ok(&mut *cstr as *mut _ as *mut c_void),
Value::Int(n) => Ok(*n as *mut c_void),
_ => Err(FFIError::ValueCast),
}
}
}
#[derive(Debug)]
pub enum FFIError {
ValueCast,
ValueDontFit,
InvalidFFIType,
InvalidStructName,
FunctionNotFound,
StructNotFound,
}

View File

@@ -1,320 +0,0 @@
use crate::parser::ast::*;
use crate::forms::*;
use crate::instructions::*;
use crate::iterators::*;
use indexmap::{IndexMap, IndexSet};
use std::cell::Cell;
use std::collections::BTreeSet;
use std::mem::swap;
use std::rc::Rc;
use std::vec::Vec;
// labeled with chunk numbers.
#[derive(Debug)]
pub(crate) enum VarStatus {
Perm(usize),
Temp(usize, TempVarData), // Perm(chunk_num) | Temp(chunk_num, _)
}
pub(crate) type OccurrenceSet = BTreeSet<(GenContext, usize)>;
// Perm: 0 initially, a stack register once processed.
// Temp: labeled with chunk_num and temp offset (unassigned if 0).
#[derive(Debug)]
pub(crate) enum VarData {
Perm(usize),
Temp(usize, usize, TempVarData),
}
impl VarData {
pub(crate) fn as_reg_type(&self) -> RegType {
match self {
&VarData::Temp(_, r, _) => RegType::Temp(r),
&VarData::Perm(r) => RegType::Perm(r),
}
}
}
#[derive(Debug)]
pub(crate) struct TempVarData {
pub(crate) last_term_arity: usize,
pub(crate) use_set: OccurrenceSet,
pub(crate) no_use_set: BTreeSet<usize>,
pub(crate) conflict_set: BTreeSet<usize>,
}
impl TempVarData {
pub(crate) fn new(last_term_arity: usize) -> Self {
TempVarData {
last_term_arity: last_term_arity,
use_set: BTreeSet::new(),
no_use_set: BTreeSet::new(),
conflict_set: BTreeSet::new(),
}
}
pub(crate) fn uses_reg(&self, reg: usize) -> bool {
for &(_, nreg) in self.use_set.iter() {
if reg == nreg {
return true;
}
}
return false;
}
pub(crate) fn populate_conflict_set(&mut self) {
if self.last_term_arity > 0 {
let arity = self.last_term_arity;
let mut conflict_set: BTreeSet<usize> = (1..arity).collect();
for &(_, reg) in self.use_set.iter() {
conflict_set.remove(&reg);
}
self.conflict_set = conflict_set;
}
}
}
type VariableFixture<'a> = (VarStatus, Vec<&'a Cell<VarReg>>);
#[derive(Debug)]
pub(crate) struct VariableFixtures<'a> {
perm_vars: IndexMap<Rc<String>, VariableFixture<'a>>,
last_chunk_temp_vars: IndexSet<Rc<String>>,
}
impl<'a> VariableFixtures<'a> {
pub(crate) fn new() -> Self {
VariableFixtures {
perm_vars: IndexMap::new(),
last_chunk_temp_vars: IndexSet::new(),
}
}
pub(crate) fn insert(&mut self, var: Rc<String>, vs: VariableFixture<'a>) {
self.perm_vars.insert(var, vs);
}
pub(crate) fn insert_last_chunk_temp_var(&mut self, var: Rc<String>) {
self.last_chunk_temp_vars.insert(var);
}
// computes no_use and conflict sets for all temp vars.
pub(crate) fn populate_restricting_sets(&mut self) {
// three stages:
// 1. move the use sets of each variable to a local IndexMap, use_set
// (iterate mutably, swap mutable refs).
// 2. drain use_set. For each use set of U, add into the
// no-use sets of appropriate variables T =/= U.
// 3. Move the use sets back to their original locations in the fixture.
// Compute the conflict set of u.
// 1.
let mut use_sets: IndexMap<Rc<String>, OccurrenceSet> = IndexMap::new();
for (var, &mut (ref mut var_status, _)) in self.iter_mut() {
if let &mut VarStatus::Temp(_, ref mut var_data) = var_status {
let mut use_set = OccurrenceSet::new();
swap(&mut var_data.use_set, &mut use_set);
use_sets.insert((*var).clone(), use_set);
}
}
for (u, use_set) in use_sets.drain(..) {
// 2.
for &(term_loc, reg) in use_set.iter() {
if let GenContext::Last(cn_u) = term_loc {
for (ref t, &mut (ref mut var_status, _)) in self.iter_mut() {
if let &mut VarStatus::Temp(cn_t, ref mut t_data) = var_status {
if cn_u == cn_t && *u != ***t {
if !t_data.uses_reg(reg) {
t_data.no_use_set.insert(reg);
}
}
}
}
}
}
// 3.
match self.get_mut(u).unwrap() {
&mut (VarStatus::Temp(_, ref mut u_data), _) => {
u_data.use_set = use_set;
u_data.populate_conflict_set();
}
_ => {}
};
}
}
fn get_mut(&mut self, u: Rc<String>) -> Option<&mut VariableFixture<'a>> {
self.perm_vars.get_mut(&u)
}
fn iter_mut(&mut self) -> indexmap::map::IterMut<Rc<String>, VariableFixture<'a>> {
self.perm_vars.iter_mut()
}
fn record_temp_info(&mut self, tvd: &mut TempVarData, arg_c: usize, term_loc: GenContext) {
match term_loc {
GenContext::Head | GenContext::Last(_) => {
tvd.use_set.insert((term_loc, arg_c));
}
_ => {}
};
}
pub(crate) fn vars_above_threshold(&self, index: usize) -> usize {
let mut var_count = 0;
for &(ref var_status, _) in self.values() {
if let &VarStatus::Perm(i) = var_status {
if i > index {
var_count += 1;
}
}
}
var_count
}
pub(crate) fn mark_vars_in_chunk<I>(&mut self, iter: I, lt_arity: usize, term_loc: GenContext)
where
I: Iterator<Item = TermRef<'a>>,
{
let chunk_num = term_loc.chunk_num();
let mut arg_c = 1;
for term_ref in iter {
if let &TermRef::Var(lvl, cell, ref var) = &term_ref {
let mut status = self.perm_vars.swap_remove(var).unwrap_or((
VarStatus::Temp(chunk_num, TempVarData::new(lt_arity)),
Vec::new(),
));
status.1.push(cell);
match status.0 {
VarStatus::Temp(cn, ref mut tvd) if cn == chunk_num => {
if let Level::Shallow = lvl {
self.record_temp_info(tvd, arg_c, term_loc);
}
}
_ => status.0 = VarStatus::Perm(chunk_num),
};
self.perm_vars.insert(var.clone(), status);
}
if let Level::Shallow = term_ref.level() {
arg_c += 1;
}
}
}
pub(crate) fn into_iter(self) -> indexmap::map::IntoIter<Rc<String>, VariableFixture<'a>> {
self.perm_vars.into_iter()
}
fn values(&self) -> indexmap::map::Values<Rc<String>, VariableFixture<'a>> {
self.perm_vars.values()
}
pub(crate) fn size(&self) -> usize {
self.perm_vars.len()
}
pub(crate) fn set_perm_vals(&self, has_deep_cuts: bool) {
let mut values_vec: Vec<_> = self
.values()
.filter_map(|ref v| match &v.0 {
&VarStatus::Perm(i) => Some((i, &v.1)),
_ => None,
})
.collect();
values_vec.sort_by_key(|ref v| v.0);
let offset = has_deep_cuts as usize;
for (i, (_, cells)) in values_vec.into_iter().rev().enumerate() {
for cell in cells {
cell.set(VarReg::Norm(RegType::Perm(i + 1 + offset)));
}
}
}
}
#[derive(Debug)]
pub(crate) struct UnsafeVarMarker {
pub(crate) unsafe_vars: IndexMap<RegType, usize>,
pub(crate) safe_vars: IndexSet<RegType>,
}
impl UnsafeVarMarker {
pub(crate) fn new() -> Self {
UnsafeVarMarker {
unsafe_vars: IndexMap::new(),
safe_vars: IndexSet::new(),
}
}
pub(crate) fn from_safe_vars(safe_vars: IndexSet<RegType>) -> Self {
UnsafeVarMarker {
unsafe_vars: IndexMap::new(),
safe_vars,
}
}
pub(crate) fn mark_safe_vars(&mut self, query_instr: &Instruction) -> bool {
match query_instr {
&Instruction::PutVariable(r @ RegType::Temp(_), _) |
&Instruction::SetVariable(r) => {
self.safe_vars.insert(r);
true
}
_ => false,
}
}
pub(crate) fn mark_phase(&mut self, query_instr: &Instruction, phase: usize) {
match query_instr {
&Instruction::PutValue(r @ RegType::Perm(_), _) |
&Instruction::SetValue(r) => {
let p = self.unsafe_vars.entry(r).or_insert(0);
*p = phase;
}
_ => {}
}
}
pub(crate) fn mark_unsafe_vars(&mut self, query_instr: &mut Instruction, phase: usize) {
match query_instr {
&mut Instruction::PutValue(RegType::Perm(i), arg) => {
if let Some(p) = self.unsafe_vars.swap_remove(&RegType::Perm(i)) {
if p == phase {
*query_instr = Instruction::PutUnsafeValue(i, arg);
self.safe_vars.insert(RegType::Perm(i));
} else {
self.unsafe_vars.insert(RegType::Perm(i), p);
}
}
}
&mut Instruction::SetValue(r) => {
if !self.safe_vars.contains(&r) {
*query_instr = Instruction::SetLocalValue(r);
self.safe_vars.insert(r);
self.unsafe_vars.remove(&r);
}
}
_ => {}
}
}
}

View File

@@ -1,13 +1,14 @@
use crate::arena::*;
use crate::atom_table::*;
use crate::instructions::*;
use crate::machine::disjuncts::VarData;
use crate::machine::heap::*;
use crate::machine::loader::PredicateQueue;
use crate::machine::machine_errors::*;
use crate::machine::machine_indices::*;
use crate::parser::ast::*;
use crate::parser::dashu::{Integer, Rational};
use crate::parser::parser::CompositeOpDesc;
use crate::parser::rug::{Integer, Rational};
use crate::types::*;
use fxhash::FxBuildHasher;
@@ -19,26 +20,23 @@ use std::cell::Cell;
use std::collections::VecDeque;
use std::convert::TryFrom;
use std::fmt;
use std::ops::AddAssign;
use std::ops::{AddAssign, Deref, DerefMut};
use std::path::PathBuf;
use std::rc::Rc;
use crate::{is_infix, is_postfix};
pub type PredicateKey = (Atom, usize); // name, arity.
pub type Predicate = Vec<PredicateClause>;
/*
// vars of predicate, toplevel offset. Vec<Term> is always a vector
// of vars (we get their adjoining cells this way).
pub type JumpStub = Vec<Term>;
*/
#[derive(Debug, Clone)]
#[derive(Debug)]
pub enum TopLevel {
Fact(Term), // Term, line_num, col_num
Predicate(Predicate),
Query(Vec<QueryTerm>),
Rule(Rule), // Rule, line_num, col_num
Fact(Fact, VarData), // Term, line_num, col_num
Rule(Rule, VarData), // Rule, line_num, col_num
}
#[derive(Debug, Clone, Copy)]
@@ -57,7 +55,13 @@ impl AppendOrPrepend {
}
}
#[derive(Debug, Clone, Copy, PartialEq, Eq)]
#[derive(Debug, Clone, Copy)]
pub enum VarComparison {
Indistinct,
Distinct,
}
#[derive(Debug, Clone, Copy, PartialEq, Eq, Hash)]
pub enum Level {
Deep,
Root,
@@ -79,38 +83,150 @@ pub enum CallPolicy {
Counted,
}
#[derive(Debug, Clone)]
#[derive(Debug, Clone, Copy, PartialEq, Eq, Hash)]
pub enum ChunkType {
Head,
Mid,
Last,
}
#[derive(Debug)]
pub enum RootIterationPolicy {
Iterated,
NotIterated,
}
impl RootIterationPolicy {
#[inline(always)]
pub fn iterable(&self) -> bool {
if let RootIterationPolicy::Iterated = self {
true
} else {
false
}
}
}
impl ChunkType {
#[inline(always)]
pub fn to_gen_context(self, chunk_num: usize) -> GenContext {
match self {
ChunkType::Head => GenContext::Head,
ChunkType::Mid => GenContext::Mid(chunk_num),
ChunkType::Last => GenContext::Last(chunk_num),
}
}
#[inline(always)]
pub fn is_last(self) -> bool {
self == ChunkType::Last
}
}
#[derive(Debug)]
pub enum ChunkedTerms {
Branch(Vec<VecDeque<ChunkedTerms>>),
Chunk(VecDeque<QueryTerm>),
}
#[derive(Debug)]
pub struct ChunkedTermVec {
pub chunk_vec: VecDeque<ChunkedTerms>,
}
impl Deref for ChunkedTermVec {
type Target = VecDeque<ChunkedTerms>;
#[inline(always)]
fn deref(&self) -> &Self::Target {
&self.chunk_vec
}
}
impl DerefMut for ChunkedTermVec {
#[inline(always)]
fn deref_mut(&mut self) -> &mut Self::Target {
&mut self.chunk_vec
}
}
impl ChunkedTermVec {
#[inline]
pub fn new() -> Self {
Self {
chunk_vec: VecDeque::new(),
}
}
pub fn reserve_branch(&mut self, capacity: usize) {
self.chunk_vec
.push_back(ChunkedTerms::Branch(Vec::with_capacity(capacity)));
}
pub fn push_branch_arm(&mut self, branch: VecDeque<ChunkedTerms>) {
match self.chunk_vec.back_mut().unwrap() {
ChunkedTerms::Branch(branches) => {
branches.push(branch);
}
ChunkedTerms::Chunk(_) => {
self.chunk_vec.push_back(ChunkedTerms::Branch(vec![branch]));
}
}
}
#[inline]
pub fn add_chunk(&mut self) {
self.chunk_vec
.push_back(ChunkedTerms::Chunk(VecDeque::from(vec![])));
}
pub fn push_chunk_term(&mut self, term: QueryTerm) {
match self.chunk_vec.back_mut() {
Some(ChunkedTerms::Branch(_)) => {
self.chunk_vec
.push_back(ChunkedTerms::Chunk(VecDeque::from(vec![term])));
}
Some(ChunkedTerms::Chunk(chunk)) => {
chunk.push_back(term);
}
None => {
self.chunk_vec
.push_back(ChunkedTerms::Chunk(VecDeque::from(vec![term])));
}
}
}
}
#[derive(Debug)]
pub enum QueryTerm {
// register, clause type, subterms, clause call policy.
Clause(Cell<RegType>, ClauseType, Vec<Term>, CallPolicy),
BlockedCut, // a cut which is 'blocked by letters', like the P term in P -> Q.
UnblockedCut(Cell<VarReg>),
GetLevelAndUnify(Cell<VarReg>, Rc<String>),
Jump(JumpStub),
Fail,
LocalCut { var_num: usize, cut_prev: bool }, // var_num
GlobalCut(usize), // var_num
GetCutPoint { var_num: usize, prev_b: bool },
GetLevel(usize), // var_num
}
impl QueryTerm {
pub(crate) fn set_call_policy(&mut self, cp: CallPolicy) {
match self {
&mut QueryTerm::Clause(_, _, _, ref mut clause_cp) => *clause_cp = cp,
_ => {}
}
}
pub(crate) fn arity(&self) -> usize {
match self {
&QueryTerm::Clause(_, _, ref subterms, ..) => subterms.len(),
&QueryTerm::BlockedCut | &QueryTerm::UnblockedCut(..) => 0,
&QueryTerm::Jump(ref vars) => vars.len(),
&QueryTerm::GetLevelAndUnify(..) => 1,
&QueryTerm::GetLevel(_) | &QueryTerm::GetCutPoint { .. } => 1,
_ => 0,
}
}
}
#[derive(Debug, Clone)]
#[derive(Debug)]
pub struct Fact {
pub(crate) head: Term,
}
#[derive(Debug)]
pub struct Rule {
pub(crate) head: (Atom, Vec<Term>, QueryTerm),
pub(crate) clauses: Vec<QueryTerm>,
pub(crate) head: (Atom, Vec<Term>),
pub(crate) clauses: ChunkedTermVec,
}
#[derive(Clone, Debug, Hash)]
@@ -156,11 +272,10 @@ impl ClauseInfo for Term {
fn name(&self) -> Option<Atom> {
match self {
Term::Clause(_, name, terms) => {
match name {
atom!(":-") => {
match terms.len() {
1 => None, // a declaration.
1 => None, // a declaration.
2 => terms[0].name(),
_ => Some(*name),
}
@@ -175,7 +290,7 @@ impl ClauseInfo for Term {
fn arity(&self) -> usize {
match self {
Term::Clause(_, name, terms) => match name.as_str() {
Term::Clause(_, name, terms) => match &*name.as_str() {
":-" => match terms.len() {
1 => 0,
2 => terms[0].arity(),
@@ -201,29 +316,29 @@ impl ClauseInfo for Rule {
impl ClauseInfo for PredicateClause {
fn name(&self) -> Option<Atom> {
match self {
&PredicateClause::Fact(ref term, ..) => term.name(),
&PredicateClause::Fact(ref term, ..) => term.head.name(),
&PredicateClause::Rule(ref rule, ..) => rule.name(),
}
}
fn arity(&self) -> usize {
match self {
&PredicateClause::Fact(ref term, ..) => term.arity(),
&PredicateClause::Fact(ref term, ..) => term.head.arity(),
&PredicateClause::Rule(ref rule, ..) => rule.arity(),
}
}
}
#[derive(Debug, Clone)]
#[derive(Debug)]
pub enum PredicateClause {
Fact(Term),
Rule(Rule),
Fact(Fact, VarData),
Rule(Rule, VarData),
}
impl PredicateClause {
pub(crate) fn args(&self) -> Option<&[Term]> {
match self {
PredicateClause::Fact(term, ..) => match term {
PredicateClause::Fact(term, ..) => match &term.head {
Term::Clause(_, _, args) => Some(&args),
_ => None,
},
@@ -300,7 +415,6 @@ pub(crate) fn fixity(spec: u32) -> Fixity {
}
}
impl OpDecl {
#[inline]
pub(crate) fn new(op_desc: OpDesc, name: Atom) -> Self {
@@ -367,35 +481,27 @@ pub enum AtomOrString {
impl AtomOrString {
#[inline]
pub fn as_atom(&self, atom_tbl: &mut AtomTable) -> Atom {
pub fn as_atom(&self, atom_tbl: &AtomTable) -> Atom {
match self {
&AtomOrString::Atom(atom) => {
atom
}
AtomOrString::String(string) => {
atom_tbl.build_with(&string)
}
&AtomOrString::Atom(atom) => atom,
AtomOrString::String(string) => AtomTable::build_with(atom_tbl, &string),
}
}
#[inline]
pub fn as_str(&self) -> &str {
pub fn as_str(&self) -> AtomString<'_> {
match self {
AtomOrString::Atom(atom) if atom == &atom!("[]") => "",
AtomOrString::Atom(atom) if atom == &atom!("[]") => AtomString::Static(""),
AtomOrString::Atom(atom) => atom.as_str(),
AtomOrString::String(string) => string.as_str(),
AtomOrString::String(string) => AtomString::Static(string.as_str()),
}
}
#[inline]
pub fn to_string(self) -> String {
match self {
AtomOrString::Atom(atom) => {
atom.as_str().to_owned()
}
AtomOrString::String(string) => {
string
}
AtomOrString::Atom(atom) => atom.as_str().to_owned(),
AtomOrString::String(string) => string,
}
}
}
@@ -451,9 +557,7 @@ pub(crate) fn fetch_op_spec(name: Atom, arity: usize, op_dir: &OpDir) -> Option<
}
})
}
0 => {
fetch_atom_op_spec(name, None, op_dir)
}
0 => fetch_atom_op_spec(name, None, op_dir),
_ => None,
}
}
@@ -485,10 +589,7 @@ pub struct Module {
// Module's and related types are defined in forms.
impl Module {
pub(crate) fn new(
module_decl: ModuleDecl,
listing_src: ListingSource,
) -> Self {
pub(crate) fn new(module_decl: ModuleDecl, listing_src: ListingSource) -> Self {
Module {
module_decl,
code_dir: CodeDir::with_hasher(FxBuildHasher::default()),
@@ -510,7 +611,7 @@ impl Module {
meta_predicates: MetaPredicateDir::with_hasher(FxBuildHasher::default()),
extensible_predicates: ExtensiblePredicates::with_hasher(FxBuildHasher::default()),
local_extensible_predicates: LocalExtensiblePredicates::with_hasher(
FxBuildHasher::default()
FxBuildHasher::default(),
),
listing_src: ListingSource::DynamicallyGenerated,
}
@@ -661,9 +762,9 @@ impl Number {
pub(crate) fn is_positive(&self) -> bool {
match self {
&Number::Fixnum(n) => n.get_num() > 0,
&Number::Integer(ref n) => &**n > &0,
&Number::Integer(ref n) => &**n > &Integer::from(0),
&Number::Float(f) => f.is_sign_positive(),
&Number::Rational(ref r) => &**r > &0,
&Number::Rational(ref r) => &**r > &Rational::from(0),
}
}
@@ -671,9 +772,9 @@ impl Number {
pub(crate) fn is_negative(&self) -> bool {
match self {
&Number::Fixnum(n) => n.get_num() < 0,
&Number::Integer(ref n) => &**n < &0,
&Number::Integer(ref n) => &**n < &Integer::from(0),
&Number::Float(OrderedFloat(f)) => f.is_sign_negative() && OrderedFloat(f) != -0f64,
&Number::Rational(ref r) => &**r < &0,
&Number::Rational(ref r) => &**r < &Rational::from(0),
}
}
@@ -681,9 +782,9 @@ impl Number {
pub(crate) fn is_zero(&self) -> bool {
match self {
&Number::Fixnum(n) => n.get_num() == 0,
&Number::Integer(ref n) => &**n == &0,
&Number::Integer(ref n) => &**n == &Integer::from(0),
&Number::Float(f) => f == OrderedFloat(0f64) || f == OrderedFloat(-0f64),
&Number::Rational(ref r) => &**r == &0,
&Number::Rational(ref r) => &**r == &Rational::from(0),
}
}
@@ -812,8 +913,11 @@ impl PredicateInfo {
}
#[inline]
pub(crate) fn must_retract_local_clauses(&self) -> bool {
self.is_extensible && self.has_clauses && !self.is_discontiguous
pub(crate) fn must_retract_local_clauses(&self, is_cross_module_clause: bool) -> bool {
self.is_extensible
&& self.has_clauses
&& !self.is_discontiguous
&& !(self.is_multifile && is_cross_module_clause)
}
}
@@ -902,19 +1006,17 @@ impl PredicateSkeleton {
&mut self,
clause_clause_loc: usize,
) -> Option<usize> {
let search_result = self.core.clause_clause_locs
.make_contiguous()[0..self.core.clause_assert_margin]
let search_result = self.core.clause_clause_locs.make_contiguous()
[0..self.core.clause_assert_margin]
.binary_search_by(|loc| clause_clause_loc.cmp(&loc));
match search_result {
Ok(loc) => Some(loc),
Err(_) => {
self.core.clause_clause_locs
.make_contiguous()[self.core.clause_assert_margin..]
.binary_search_by(|loc| loc.cmp(&clause_clause_loc))
.map(|loc| loc + self.core.clause_assert_margin)
.ok()
}
Err(_) => self.core.clause_clause_locs.make_contiguous()
[self.core.clause_assert_margin..]
.binary_search_by(|loc| loc.cmp(&clause_clause_loc))
.map(|loc| loc + self.core.clause_assert_margin)
.ok(),
}
}
}

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@@ -1,25 +1,23 @@
use std::sync::Arc;
use std::convert::Infallible;
use std::sync::{Arc, Mutex, Condvar};
use std::io::BufRead;
use hyper::{Response, Request, Body};
use tokio::sync::Mutex;
use tokio::sync::mpsc::{channel, Receiver, Sender};
use warp::http;
pub struct HttpListener {
pub incoming: Receiver<HttpRequest>
pub incoming: std::sync::mpsc::Receiver<HttpRequest>,
}
#[derive(Debug)]
pub struct HttpRequest {
pub request: Request<Body>,
pub request_data: HttpRequestData,
pub response: HttpResponse,
}
pub type HttpResponse = Sender<Response<Body>>;
pub type HttpResponse = Arc<(Mutex<bool>, Mutex<Option<warp::reply::Response>>, Condvar)>;
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())
pub struct HttpRequestData {
pub method: http::Method,
pub headers: http::HeaderMap,
pub path: String,
pub query: String,
pub body: Box<dyn BufRead + Send>,
}

View File

@@ -150,17 +150,20 @@ impl<'a> IndexingCodeMergingPtr<'a> {
let third_level_index = if self.append_or_prepend.is_append() {
vec![
IndexedChoiceInstruction::Try(external),
IndexedChoiceInstruction::Trust(index)
].into()
IndexedChoiceInstruction::Trust(index),
]
.into()
} else {
vec![
IndexedChoiceInstruction::Try(index),
IndexedChoiceInstruction::Trust(external)
].into()
IndexedChoiceInstruction::Trust(external),
]
.into()
};
let indexing_code_len = self.indexing_code.len();
self.indexing_code.push(IndexingLine::IndexedChoice(third_level_index));
self.indexing_code
.push(IndexingLine::IndexedChoice(third_level_index));
match &mut self.indexing_code[self.offset] {
IndexingLine::Indexing(IndexingInstruction::SwitchOnConstant(ref mut constants)) => {
@@ -188,7 +191,8 @@ impl<'a> IndexingCodeMergingPtr<'a> {
};
let indexing_code_len = self.indexing_code.len();
self.indexing_code.push(IndexingLine::DynamicIndexedChoice(third_level_index));
self.indexing_code
.push(IndexingLine::DynamicIndexedChoice(third_level_index));
match &mut self.indexing_code[self.offset] {
IndexingLine::Indexing(IndexingInstruction::SwitchOnConstant(ref mut constants)) => {
@@ -275,10 +279,8 @@ impl<'a> IndexingCodeMergingPtr<'a> {
);
}
None | Some(IndexingCodePtr::Fail) => {
constants.insert(
overlapping_constant,
IndexingCodePtr::External(index),
);
constants
.insert(overlapping_constant, IndexingCodePtr::External(index));
}
Some(IndexingCodePtr::DynamicExternal(o)) => {
self.add_dynamic_indexed_choice_for_constant(
@@ -345,16 +347,10 @@ impl<'a> IndexingCodeMergingPtr<'a> {
IndexingLine::Indexing(IndexingInstruction::SwitchOnConstant(constants)) => {
match constants.get(&constant).cloned() {
None | Some(IndexingCodePtr::Fail) if self.is_dynamic => {
constants.insert(
constant,
IndexingCodePtr::DynamicExternal(index),
);
constants.insert(constant, IndexingCodePtr::DynamicExternal(index));
}
None | Some(IndexingCodePtr::Fail) => {
constants.insert(
constant,
IndexingCodePtr::External(index),
);
constants.insert(constant, IndexingCodePtr::External(index));
}
Some(IndexingCodePtr::DynamicExternal(o)) => {
self.add_dynamic_indexed_choice_for_constant(o, constant, index);
@@ -432,17 +428,20 @@ impl<'a> IndexingCodeMergingPtr<'a> {
let third_level_index = if self.append_or_prepend.is_append() {
vec![
IndexedChoiceInstruction::Try(external),
IndexedChoiceInstruction::Trust(index)
].into()
IndexedChoiceInstruction::Trust(index),
]
.into()
} else {
vec![
IndexedChoiceInstruction::Try(index),
IndexedChoiceInstruction::Trust(external)
].into()
IndexedChoiceInstruction::Trust(external),
]
.into()
};
let indexing_code_len = self.indexing_code.len();
self.indexing_code.push(IndexingLine::IndexedChoice(third_level_index));
self.indexing_code
.push(IndexingLine::IndexedChoice(third_level_index));
match &mut self.indexing_code[self.offset] {
IndexingLine::Indexing(IndexingInstruction::SwitchOnStructure(ref mut structures)) => {
@@ -470,7 +469,8 @@ impl<'a> IndexingCodeMergingPtr<'a> {
};
let indexing_code_len = self.indexing_code.len();
self.indexing_code.push(IndexingLine::DynamicIndexedChoice(third_level_index));
self.indexing_code
.push(IndexingLine::DynamicIndexedChoice(third_level_index));
match &mut self.indexing_code[self.offset] {
IndexingLine::Indexing(IndexingInstruction::SwitchOnStructure(ref mut structures)) => {
@@ -584,13 +584,15 @@ impl<'a> IndexingCodeMergingPtr<'a> {
let third_level_index = if self.append_or_prepend.is_append() {
vec![
IndexedChoiceInstruction::Try(o),
IndexedChoiceInstruction::Trust(index)
].into()
IndexedChoiceInstruction::Trust(index),
]
.into()
} else {
vec![
IndexedChoiceInstruction::Try(index),
IndexedChoiceInstruction::Trust(o)
].into()
IndexedChoiceInstruction::Trust(o),
]
.into()
};
self.indexing_code
@@ -613,7 +615,7 @@ pub(crate) fn merge_clause_index(
target_indexing_code: &mut Vec<IndexingLine>,
skeleton: &mut [ClauseIndexInfo], // the clause to be merged is the last element in the skeleton.
retracted_clauses: &Option<Vec<ClauseIndexInfo>>,
new_clause_loc: usize, // the absolute location of the new clause in the code vector.
new_clause_loc: usize, // the absolute location of the new clause in the code vector.
append_or_prepend: AppendOrPrepend,
) {
let opt_arg_index_key = match append_or_prepend {
@@ -636,11 +638,7 @@ pub(crate) fn merge_clause_index(
for overlapping_constant in overlapping_constants {
merging_ptr.offset = 0;
merging_ptr.index_overlapping_constant(
*constant,
*overlapping_constant,
offset,
);
merging_ptr.index_overlapping_constant(*constant, *overlapping_constant, offset);
}
}
OptArgIndexKey::Structure(_, index_loc, name, arity) => {
@@ -1060,19 +1058,27 @@ fn cap_choice_seq(prelude: &mut [IndexedChoiceInstruction]) {
#[inline]
fn cap_choice_seq_with_trust(prelude: &mut [IndexedChoiceInstruction]) {
prelude.last_mut().map(|instr| {
if let IndexedChoiceInstruction::Retry(i) = instr {
prelude.last_mut().map(|instr| match instr {
IndexedChoiceInstruction::Retry(i) => {
*instr = IndexedChoiceInstruction::Trust(*i);
}
IndexedChoiceInstruction::DefaultRetry(i) => {
*instr = IndexedChoiceInstruction::DefaultTrust(*i);
}
_ => {}
});
}
#[inline]
fn uncap_choice_seq_with_trust(prelude: &mut [IndexedChoiceInstruction]) {
prelude.last_mut().map(|instr| {
if let IndexedChoiceInstruction::Trust(i) = instr {
prelude.last_mut().map(|instr| match instr {
IndexedChoiceInstruction::Trust(i) => {
*instr = IndexedChoiceInstruction::Retry(*i);
}
IndexedChoiceInstruction::DefaultTrust(i) => {
*instr = IndexedChoiceInstruction::DefaultRetry(*i);
}
_ => {}
});
}
@@ -1087,7 +1093,7 @@ fn uncap_choice_seq_with_try(prelude: &mut [IndexedChoiceInstruction]) {
pub(crate) fn constant_key_alternatives(
constant: Literal,
atom_tbl: &mut AtomTable,
atom_tbl: &AtomTable,
// arena: &mut Arena,
) -> Vec<Literal> {
let mut constants = vec![];
@@ -1099,7 +1105,7 @@ pub(crate) fn constant_key_alternatives(
}
}
Literal::Char(c) => {
let atom = atom_tbl.build_with(&c.to_string());
let atom = AtomTable::build_with(&atom_tbl, &c.to_string());
constants.push(Literal::Atom(atom));
}
/*
@@ -1116,8 +1122,9 @@ pub(crate) fn constant_key_alternatives(
}
*/
Literal::Integer(ref n) => {
if let Some(n) = n.to_isize() {
Fixnum::build_with_checked(n as i64).map(|n| {
let result = (&**n).try_into();
if let Ok(value) = result {
Fixnum::build_with_checked(value).map(|n| {
constants.push(Literal::Fixnum(n));
}).unwrap();
}
@@ -1147,11 +1154,19 @@ pub(crate) trait Indexer {
fn new() -> Self;
fn constants(&mut self) -> &mut IndexMap<Literal, VecDeque<Self::ThirdLevelIndex>, FxBuildHasher>;
fn constants(
&mut self,
) -> &mut IndexMap<Literal, VecDeque<Self::ThirdLevelIndex>, FxBuildHasher>;
fn lists(&mut self) -> &mut VecDeque<Self::ThirdLevelIndex>;
fn structures(&mut self) -> &mut IndexMap<(Atom, usize), VecDeque<Self::ThirdLevelIndex>, FxBuildHasher>;
fn structures(
&mut self,
) -> &mut IndexMap<(Atom, usize), VecDeque<Self::ThirdLevelIndex>, FxBuildHasher>;
fn compute_index(is_initial_index: bool, index: usize) -> Self::ThirdLevelIndex;
fn compute_index(
is_initial_index: bool,
index: usize,
non_counted_bt: bool,
) -> Self::ThirdLevelIndex;
fn second_level_index<IndexKey: Eq + Hash>(
indices: IndexMap<IndexKey, VecDeque<Self::ThirdLevelIndex>, FxBuildHasher>,
@@ -1187,7 +1202,9 @@ impl Indexer for StaticCodeIndices {
}
#[inline]
fn constants(&mut self) -> &mut IndexMap<Literal, VecDeque<IndexedChoiceInstruction>, FxBuildHasher> {
fn constants(
&mut self,
) -> &mut IndexMap<Literal, VecDeque<IndexedChoiceInstruction>, FxBuildHasher> {
&mut self.constants
}
@@ -1197,13 +1214,21 @@ impl Indexer for StaticCodeIndices {
}
#[inline]
fn structures(&mut self) -> &mut IndexMap<(Atom, usize), VecDeque<IndexedChoiceInstruction>, FxBuildHasher> {
fn structures(
&mut self,
) -> &mut IndexMap<(Atom, usize), VecDeque<IndexedChoiceInstruction>, FxBuildHasher> {
&mut self.structures
}
fn compute_index(is_initial_index: bool, index: usize) -> IndexedChoiceInstruction {
fn compute_index(
is_initial_index: bool,
index: usize,
non_counted_bt: bool,
) -> IndexedChoiceInstruction {
if is_initial_index {
IndexedChoiceInstruction::Try(index + 1)
} else if non_counted_bt {
IndexedChoiceInstruction::DefaultRetry(index + 1)
} else {
IndexedChoiceInstruction::Retry(index + 1)
}
@@ -1231,7 +1256,9 @@ impl Indexer for StaticCodeIndices {
}
fn switch_on<IndexKey: Eq + Hash>(
mut instr_fn: impl FnMut(IndexMap<IndexKey, IndexingCodePtr, FxBuildHasher>) -> IndexingInstruction,
mut instr_fn: impl FnMut(
IndexMap<IndexKey, IndexingCodePtr, FxBuildHasher>,
) -> IndexingInstruction,
index: &mut IndexMap<IndexKey, VecDeque<IndexedChoiceInstruction>, FxBuildHasher>,
prelude: &mut VecDeque<IndexingLine>,
) -> IndexingCodePtr {
@@ -1318,7 +1345,7 @@ impl Indexer for DynamicCodeIndices {
}
#[inline]
fn compute_index(_: bool, index: usize) -> usize {
fn compute_index(_: bool, index: usize, _: bool) -> usize {
index + 1
}
@@ -1331,7 +1358,9 @@ impl Indexer for DynamicCodeIndices {
for (key, code) in indices.into_iter() {
if code.len() > 1 {
index_locs.insert(key, IndexingCodePtr::Internal(prelude.len() + 1));
prelude.push_back(IndexingLine::DynamicIndexedChoice(code.into_iter().collect()));
prelude.push_back(IndexingLine::DynamicIndexedChoice(
code.into_iter().collect(),
));
} else {
code.front().map(|i| {
index_locs.insert(key, IndexingCodePtr::DynamicExternal(*i));
@@ -1343,7 +1372,9 @@ impl Indexer for DynamicCodeIndices {
}
fn switch_on<IndexKey: Eq + Hash>(
mut instr_fn: impl FnMut(IndexMap<IndexKey, IndexingCodePtr, FxBuildHasher>) -> IndexingInstruction,
mut instr_fn: impl FnMut(
IndexMap<IndexKey, IndexingCodePtr, FxBuildHasher>,
) -> IndexingInstruction,
index: &mut IndexMap<IndexKey, VecDeque<usize>, FxBuildHasher>,
prelude: &mut VecDeque<IndexingLine>,
) -> IndexingCodePtr {
@@ -1370,7 +1401,9 @@ impl Indexer for DynamicCodeIndices {
) -> IndexingCodePtr {
if lists.len() > 1 {
let lists = mem::replace(lists, VecDeque::new());
prelude.push_back(IndexingLine::DynamicIndexedChoice(lists.into_iter().collect()));
prelude.push_back(IndexingLine::DynamicIndexedChoice(
lists.into_iter().collect(),
));
IndexingCodePtr::Internal(1)
} else {
lists
@@ -1400,33 +1433,43 @@ impl Indexer for DynamicCodeIndices {
pub(crate) struct CodeOffsets<I: Indexer> {
indices: I,
optimal_index: usize,
non_counted_bt: bool,
}
impl<I: Indexer> CodeOffsets<I> {
pub(crate) fn new(indices: I, optimal_index: usize) -> Self {
pub(crate) fn new(indices: I, optimal_index: usize, non_counted_bt: bool) -> Self {
CodeOffsets {
indices,
optimal_index,
non_counted_bt,
}
}
fn index_list(&mut self, index: usize) {
let is_initial_index = self.indices.lists().is_empty();
let index = I::compute_index(is_initial_index, index);
let index = I::compute_index(is_initial_index, index, self.non_counted_bt);
self.indices.lists().push_back(index);
}
fn index_constant(
&mut self,
atom_tbl: &mut AtomTable,
atom_tbl: &AtomTable,
constant: Literal,
index: usize,
) -> Vec<Literal> {
let overlapping_constants = constant_key_alternatives(constant, atom_tbl);
let code = self.indices.constants().entry(constant).or_insert(VecDeque::new());
let code = self
.indices
.constants()
.entry(constant)
.or_insert(VecDeque::new());
let is_initial_index = code.is_empty();
code.push_back(I::compute_index(is_initial_index, index));
code.push_back(I::compute_index(
is_initial_index,
index,
self.non_counted_bt,
));
for constant in &overlapping_constants {
let code = self
@@ -1436,7 +1479,7 @@ impl<I: Indexer> CodeOffsets<I> {
.or_insert(VecDeque::new());
let is_initial_index = code.is_empty();
let index = I::compute_index(is_initial_index, index);
let index = I::compute_index(is_initial_index, index, self.non_counted_bt);
code.push_back(index);
}
@@ -1454,7 +1497,11 @@ impl<I: Indexer> CodeOffsets<I> {
let code_len = code.len();
let is_initial_index = code.is_empty();
code.push_back(I::compute_index(is_initial_index, index));
code.push_back(I::compute_index(
is_initial_index,
index,
self.non_counted_bt,
));
code_len
}
@@ -1463,7 +1510,7 @@ impl<I: Indexer> CodeOffsets<I> {
optimal_arg: &Term,
index: usize,
clause_index_info: &mut ClauseIndexInfo,
atom_tbl: &mut AtomTable,
atom_tbl: &AtomTable,
) {
match optimal_arg {
&Term::Clause(_, atom!("."), ref terms) if terms.len() == 2 => {

View File

@@ -5,9 +5,7 @@ use crate::parser::ast::*;
use std::cell::Cell;
use std::collections::VecDeque;
use std::fmt;
use std::iter::*;
use std::rc::Rc;
use std::vec::Vec;
#[derive(Debug, Clone)]
@@ -18,34 +16,36 @@ pub(crate) enum TermRef<'a> {
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>),
Var(Level, &'a Cell<VarReg>, VarPtr),
}
/*
impl<'a> TermRef<'a> {
pub(crate) fn level(self) -> Level {
pub(crate) fn level(&self) -> Level {
match self {
TermRef::AnonVar(lvl)
| TermRef::Cons(lvl, ..)
| TermRef::Literal(lvl, ..)
| TermRef::Var(lvl, ..)
| TermRef::Clause(lvl, ..)
| TermRef::CompleteString(lvl, ..)
| TermRef::PartialString(lvl, ..) => lvl,
TermRef::AnonVar(lvl) |
TermRef::Cons(lvl, ..) |
TermRef::Literal(lvl, ..) |
TermRef::Var(lvl, ..) |
TermRef::Clause(lvl, ..) |
TermRef::CompleteString(lvl, ..) |
TermRef::PartialString(lvl, ..) => *lvl,
}
}
}
*/
#[derive(Debug)]
pub(crate) enum TermIterState<'a> {
AnonVar(Level),
Literal(Level, &'a Cell<RegType>, &'a Literal),
Clause(Level, usize, &'a Cell<RegType>, Atom, &'a Vec<Term>),
Literal(Level, &'a Cell<RegType>, &'a Literal),
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>),
FinalPartialString(Level, &'a Cell<RegType>, &'a String, &'a Box<Term>),
CompleteString(Level, &'a Cell<RegType>, Atom),
Var(Level, &'a Cell<VarReg>, Rc<String>),
Var(Level, &'a Cell<VarReg>, VarPtr),
}
impl<'a> TermIterState<'a> {
@@ -62,10 +62,8 @@ impl<'a> TermIterState<'a> {
Term::PartialString(cell, string_buf, tail) => {
TermIterState::InitialPartialString(lvl, cell, string_buf, tail)
}
Term::CompleteString(cell, atom) => {
TermIterState::CompleteString(lvl, cell, *atom)
}
Term::Var(cell, var) => TermIterState::Var(lvl, cell, var.clone()),
Term::CompleteString(cell, atom) => TermIterState::CompleteString(lvl, cell, *atom),
Term::Var(cell, var_ptr) => TermIterState::Var(lvl, cell, var_ptr.clone()),
}
}
}
@@ -81,6 +79,7 @@ impl<'a> QueryIterator<'a> {
.push(TermIterState::subterm_to_state(lvl, term));
}
/*
fn from_rule_head_clause(terms: &'a Vec<Term>) -> Self {
let state_stack = terms
.iter()
@@ -90,23 +89,21 @@ impl<'a> QueryIterator<'a> {
QueryIterator { state_stack }
}
*/
fn from_term(term: &'a Term) -> Self {
let state = match term {
Term::AnonVar | Term::Cons(..) | Term::Literal(..) |
Term::PartialString(..) | Term::CompleteString(..) => {
Term::AnonVar
| Term::Cons(..)
| Term::Literal(..)
| Term::PartialString(..)
| Term::CompleteString(..) => {
return QueryIterator {
state_stack: vec![],
}
}
Term::Clause(r, name, terms) => TermIterState::Clause(
Level::Root,
0,
r,
*name,
terms,
),
Term::Var(cell, var) => TermIterState::Var(Level::Root, cell, var.clone()),
Term::Clause(r, name, terms) => TermIterState::Clause(Level::Root, 0, r, *name, terms),
Term::Var(cell, var_ptr) => TermIterState::Var(Level::Root, cell, var_ptr.clone()),
};
QueryIterator {
@@ -114,46 +111,27 @@ impl<'a> QueryIterator<'a> {
}
}
fn new(term: &'a QueryTerm) -> Self {
fn extend_state(&mut self, lvl: Level, term: &'a QueryTerm) {
match term {
&QueryTerm::Clause(ref cell, ClauseType::CallN(_), ref terms, _) => {
let state = TermIterState::Clause(Level::Root, 1, cell, atom!("$call"), terms);
QueryIterator {
state_stack: vec![state],
}
self.state_stack
.push(TermIterState::Clause(lvl, 1, cell, atom!("$call"), terms));
}
&QueryTerm::Clause(ref cell, ref ct, ref terms, _) => {
let state = TermIterState::Clause(Level::Root, 0, cell, ct.name(), terms);
QueryIterator {
state_stack: vec![state],
}
self.state_stack
.push(TermIterState::Clause(lvl, 0, cell, ct.name(), terms));
}
&QueryTerm::UnblockedCut(ref cell) => {
let state = TermIterState::Var(Level::Root, cell, Rc::new("!".to_string()));
QueryIterator {
state_stack: vec![state],
}
}
&QueryTerm::GetLevelAndUnify(ref cell, ref var) => {
let state = TermIterState::Var(Level::Root, cell, var.clone());
QueryIterator {
state_stack: vec![state],
}
}
&QueryTerm::Jump(ref vars) => {
let state_stack = vars
.iter()
.rev()
.map(|t| TermIterState::subterm_to_state(Level::Shallow, t))
.collect();
QueryIterator { state_stack }
}
&QueryTerm::BlockedCut => QueryIterator {
state_stack: vec![],
},
_ => {}
}
}
pub fn new(term: &'a QueryTerm) -> Self {
let mut iter = QueryIterator {
state_stack: vec![],
};
iter.extend_state(Level::Root, term);
iter
}
}
impl<'a> Iterator for QueryIterator<'a> {
@@ -191,13 +169,15 @@ impl<'a> Iterator for QueryIterator<'a> {
}
}
TermIterState::InitialCons(lvl, cell, head, tail) => {
self.state_stack.push(TermIterState::FinalCons(lvl, cell, head, tail));
self.state_stack
.push(TermIterState::FinalCons(lvl, cell, head, tail));
self.push_subterm(lvl.child_level(), tail);
self.push_subterm(lvl.child_level(), head);
}
TermIterState::InitialPartialString(lvl, cell, string, tail) => {
self.state_stack.push(TermIterState::FinalPartialString(lvl, cell, string, tail));
self.state_stack
.push(TermIterState::FinalPartialString(lvl, cell, string, tail));
self.push_subterm(lvl.child_level(), tail);
}
TermIterState::FinalPartialString(lvl, cell, atom, tail) => {
@@ -212,8 +192,8 @@ impl<'a> Iterator for QueryIterator<'a> {
TermIterState::Literal(lvl, cell, constant) => {
return Some(TermRef::Literal(lvl, cell, constant));
}
TermIterState::Var(lvl, cell, var) => {
return Some(TermRef::Var(lvl, cell, var));
TermIterState::Var(lvl, cell, var_ptr) => {
return Some(TermRef::Var(lvl, cell, var_ptr));
}
};
}
@@ -225,7 +205,7 @@ impl<'a> Iterator for QueryIterator<'a> {
#[derive(Debug)]
pub(crate) struct FactIterator<'a> {
state_queue: VecDeque<TermIterState<'a>>,
iterable_root: bool,
iterable_root: RootIterationPolicy,
}
impl<'a> FactIterator<'a> {
@@ -242,11 +222,11 @@ impl<'a> FactIterator<'a> {
FactIterator {
state_queue,
iterable_root: false,
iterable_root: RootIterationPolicy::NotIterated,
}
}
fn new(term: &'a Term, iterable_root: bool) -> Self {
fn new(term: &'a Term, iterable_root: RootIterationPolicy) -> Self {
let states = match term {
Term::AnonVar => {
vec![TermIterState::AnonVar(Level::Root)]
@@ -269,17 +249,13 @@ impl<'a> FactIterator<'a> {
)]
}
Term::CompleteString(cell, atom) => {
vec![TermIterState::CompleteString(
Level::Root,
cell,
*atom,
)]
vec![TermIterState::CompleteString(Level::Root, cell, *atom)]
}
Term::Literal(cell, constant) => {
vec![TermIterState::Literal(Level::Root, cell, constant)]
}
Term::Var(cell, var) => {
vec![TermIterState::Var(Level::Root, cell, var.clone())]
Term::Var(cell, var_ptr) => {
vec![TermIterState::Var(Level::Root, cell, var_ptr.clone())]
}
};
@@ -305,7 +281,7 @@ impl<'a> Iterator for FactIterator<'a> {
}
match lvl {
Level::Root if !self.iterable_root => continue,
Level::Root if !self.iterable_root.iterable() => continue,
_ => return Some(TermRef::Clause(lvl, cell, name, child_terms)),
};
}
@@ -325,8 +301,8 @@ impl<'a> Iterator for FactIterator<'a> {
TermIterState::Literal(lvl, cell, constant) => {
return Some(TermRef::Literal(lvl, cell, constant))
}
TermIterState::Var(lvl, cell, var) => {
return Some(TermRef::Var(lvl, cell, var));
TermIterState::Var(lvl, cell, var_ptr) => {
return Some(TermRef::Var(lvl, cell, var_ptr));
}
_ => {}
}
@@ -340,193 +316,134 @@ pub(crate) fn post_order_iter<'a>(term: &'a Term) -> QueryIterator<'a> {
QueryIterator::from_term(term)
}
pub(crate) fn breadth_first_iter<'a>(term: &'a Term, iterable_root: bool) -> FactIterator<'a> {
pub(crate) fn breadth_first_iter<'a>(
term: &'a Term,
iterable_root: RootIterationPolicy,
) -> FactIterator<'a> {
FactIterator::new(term, iterable_root)
}
#[derive(Debug, Copy, Clone)]
enum ClauseIteratorState<'a> {
RemainingChunks(&'a VecDeque<ChunkedTerms>, usize),
RemainingBranches(&'a Vec<VecDeque<ChunkedTerms>>, usize),
}
#[derive(Debug, Clone)]
pub(crate) enum ClauseItem<'a> {
FirstBranch(usize),
NextBranch,
BranchEnd(usize),
Chunk(&'a VecDeque<QueryTerm>),
}
#[derive(Debug)]
pub(crate) enum ChunkedTerm<'a> {
HeadClause(Atom, &'a Vec<Term>),
BodyTerm(&'a QueryTerm),
pub(crate) struct ClauseIterator<'a> {
state_stack: Vec<ClauseIteratorState<'a>>,
remaining_chunks_on_stack: usize,
}
pub(crate) fn query_term_post_order_iter<'a>(query_term: &'a QueryTerm) -> QueryIterator<'a> {
QueryIterator::new(query_term)
}
impl<'a> ChunkedTerm<'a> {
pub(crate) fn post_order_iter(&self) -> QueryIterator<'a> {
match self {
&ChunkedTerm::BodyTerm(qt) => QueryIterator::new(qt),
&ChunkedTerm::HeadClause(_, terms) => QueryIterator::from_rule_head_clause(terms),
fn state_from_chunked_terms<'a>(chunk_vec: &'a VecDeque<ChunkedTerms>) -> ClauseIteratorState<'a> {
if chunk_vec.len() == 1 {
if let Some(ChunkedTerms::Branch(ref branches)) = chunk_vec.front() {
return ClauseIteratorState::RemainingBranches(branches, 0);
}
}
ClauseIteratorState::RemainingChunks(chunk_vec, 0)
}
fn contains_cut_var<'a, Iter: Iterator<Item = &'a Term>>(terms: Iter) -> bool {
for term in terms {
if let &Term::Var(_, ref var) = term {
if var.as_str() == "!" {
return true;
impl<'a> ClauseIterator<'a> {
pub fn new(clauses: &'a ChunkedTermVec) -> Self {
match state_from_chunked_terms(&clauses.chunk_vec) {
state @ ClauseIteratorState::RemainingBranches(..) => Self {
state_stack: vec![state],
remaining_chunks_on_stack: 0,
},
state @ ClauseIteratorState::RemainingChunks(..) => Self {
state_stack: vec![state],
remaining_chunks_on_stack: 1,
},
}
}
#[inline(always)]
pub fn in_tail_position(&self) -> bool {
self.remaining_chunks_on_stack == 0
}
fn branch_end_depth(&mut self) -> usize {
let mut depth = 1;
while let Some(state) = self.state_stack.pop() {
match state {
ClauseIteratorState::RemainingBranches(terms, focus) if terms.len() == focus => {
depth += 1;
}
_ => {
self.state_stack.push(state);
break;
}
}
}
}
false
}
pub(crate) struct ChunkedIterator<'a> {
pub(crate) chunk_num: usize,
iter: Box<dyn Iterator<Item = ChunkedTerm<'a>> + 'a>,
deep_cut_encountered: bool,
cut_var_in_head: bool,
}
impl<'a> fmt::Debug for ChunkedIterator<'a> {
fn fmt(&self, fmt: &mut fmt::Formatter<'_>) -> fmt::Result {
fmt.debug_struct("ChunkedIterator")
.field("chunk_num", &self.chunk_num)
// Hacky solution.
.field("iter", &"Box<dyn Iterator<Item = ChunkedTerm<'a>> + 'a>")
.field("deep_cut_encountered", &self.deep_cut_encountered)
.field("cut_var_in_head", &self.cut_var_in_head)
.finish()
depth
}
}
type ChunkedIteratorItem<'a> = (usize, usize, Vec<ChunkedTerm<'a>>);
type RuleBodyIteratorItem<'a> = (usize, usize, Vec<&'a QueryTerm>);
impl<'a> ChunkedIterator<'a> {
pub(crate) fn rule_body_iter(self) -> Box<dyn Iterator<Item = RuleBodyIteratorItem<'a>> + 'a> {
Box::new(self.filter_map(|(cn, lt_arity, terms)| {
let filtered_terms: Vec<_> = terms
.into_iter()
.filter_map(|ct| match ct {
ChunkedTerm::BodyTerm(qt) => Some(qt),
_ => None,
})
.collect();
if filtered_terms.is_empty() {
None
} else {
Some((cn, lt_arity, filtered_terms))
}
}))
}
pub(crate) fn from_rule_body(p1: &'a QueryTerm, clauses: &'a Vec<QueryTerm>) -> Self {
let inner_iter = Box::new(once(ChunkedTerm::BodyTerm(p1)));
let iter = inner_iter.chain(clauses.iter().map(|t| ChunkedTerm::BodyTerm(t)));
ChunkedIterator {
chunk_num: 0,
iter: Box::new(iter),
deep_cut_encountered: false,
cut_var_in_head: false,
}
}
pub(crate) fn from_rule(rule: &'a Rule) -> Self {
let &Rule {
head: (ref name, ref args, ref p1),
ref clauses,
} = rule;
let iter = once(ChunkedTerm::HeadClause(name.clone(), args));
let inner_iter = Box::new(once(ChunkedTerm::BodyTerm(p1)));
let iter = iter.chain(inner_iter.chain(clauses.iter().map(|t| ChunkedTerm::BodyTerm(t))));
ChunkedIterator {
chunk_num: 0,
iter: Box::new(iter),
deep_cut_encountered: false,
cut_var_in_head: false,
}
}
pub(crate) fn encountered_deep_cut(&self) -> bool {
self.deep_cut_encountered
}
fn take_chunk(&mut self, term: ChunkedTerm<'a>) -> (usize, usize, Vec<ChunkedTerm<'a>>) {
let mut arity = 0;
let mut item = Some(term);
let mut result = Vec::new();
while let Some(term) = item {
match term {
ChunkedTerm::HeadClause(_, terms) => {
if contains_cut_var(terms.iter()) {
self.cut_var_in_head = true;
}
result.push(term);
}
ChunkedTerm::BodyTerm(&QueryTerm::Jump(ref vars)) => {
result.push(term);
arity = vars.len();
if contains_cut_var(vars.iter()) && !self.cut_var_in_head {
self.deep_cut_encountered = true;
}
break;
}
ChunkedTerm::BodyTerm(&QueryTerm::BlockedCut) => {
result.push(term);
if self.chunk_num > 0 {
self.deep_cut_encountered = true;
}
}
ChunkedTerm::BodyTerm(&QueryTerm::GetLevelAndUnify(..)) => {
self.deep_cut_encountered = true;
result.push(term);
arity = 1;
break;
}
ChunkedTerm::BodyTerm(&QueryTerm::UnblockedCut(..)) => {
self.deep_cut_encountered = true;
result.push(term);
}
ChunkedTerm::BodyTerm(&QueryTerm::Clause(_, ClauseType::Inlined(_), ..)) => {
result.push(term)
}
ChunkedTerm::BodyTerm(&QueryTerm::Clause(
_,
ClauseType::CallN(_),
ref subterms,
_,
)) => {
result.push(term);
arity = subterms.len() + 1;
break;
}
ChunkedTerm::BodyTerm(qt) => {
result.push(term);
arity = qt.arity();
break;
}
};
item = self.iter.next();
}
let chunk_num = self.chunk_num;
self.chunk_num += 1;
(chunk_num, arity, result)
}
}
impl<'a> Iterator for ChunkedIterator<'a> {
// the chunk number, last term arity, and vector of references.
type Item = ChunkedIteratorItem<'a>;
impl<'a> Iterator for ClauseIterator<'a> {
type Item = ClauseItem<'a>;
fn next(&mut self) -> Option<Self::Item> {
self.iter.next().map(|term| self.take_chunk(term))
while let Some(state) = self.state_stack.pop() {
match state {
ClauseIteratorState::RemainingChunks(chunks, focus) if focus < chunks.len() => {
if focus + 1 < chunks.len() {
self.state_stack
.push(ClauseIteratorState::RemainingChunks(chunks, focus + 1));
} else {
self.remaining_chunks_on_stack -= 1;
}
match &chunks[focus] {
ChunkedTerms::Branch(branches) => {
self.state_stack
.push(ClauseIteratorState::RemainingBranches(branches, 0));
}
ChunkedTerms::Chunk(chunk) => {
return Some(ClauseItem::Chunk(chunk));
}
}
}
ClauseIteratorState::RemainingChunks(chunks, focus) => {
debug_assert_eq!(chunks.len(), focus);
}
ClauseIteratorState::RemainingBranches(branches, focus)
if focus < branches.len() =>
{
self.state_stack
.push(ClauseIteratorState::RemainingBranches(&branches, focus + 1));
let state = state_from_chunked_terms(&branches[focus]);
if let ClauseIteratorState::RemainingChunks(..) = &state {
self.remaining_chunks_on_stack += 1;
}
self.state_stack.push(state);
return if focus == 0 {
Some(ClauseItem::FirstBranch(branches.len()))
} else {
Some(ClauseItem::NextBranch)
};
}
ClauseIteratorState::RemainingBranches(branches, focus) => {
debug_assert_eq!(branches.len(), focus);
return Some(ClauseItem::BranchEnd(self.branch_end_depth()));
}
}
}
None
}
}

View File

@@ -2,6 +2,8 @@
#[macro_use]
extern crate static_assertions;
#[cfg(test)]
#[macro_use] extern crate maplit;
#[macro_use]
pub mod macros;
@@ -15,12 +17,15 @@ mod allocator;
mod arithmetic;
pub mod codegen;
mod debray_allocator;
mod fixtures;
#[cfg(feature = "ffi")]
mod ffi;
mod forms;
mod heap_iter;
pub mod heap_print;
#[cfg(feature = "http")]
mod http;
mod indexing;
mod variable_records;
#[macro_use]
pub mod instructions {
include!(concat!(env!("OUT_DIR"), "/instructions.rs"));
@@ -29,8 +34,24 @@ mod iterators;
pub mod machine;
mod raw_block;
pub mod read;
#[cfg(feature = "repl")]
mod repl_helper;
mod targets;
pub mod types;
use instructions::instr;
mod rcu;
#[cfg(target_arch = "wasm32")]
use wasm_bindgen::prelude::*;
#[cfg(target_arch = "wasm32")]
#[wasm_bindgen]
pub fn eval_code(s: &str) -> String {
use machine::mock_wam::*;
let mut wam = Machine::with_test_streams();
let bytes = wam.test_load_string(s);
String::from_utf8_lossy(&bytes).to_string()
}

View File

@@ -1,4 +1,9 @@
:- module(arithmetic, [expmod/4, lsb/2, msb/2, number_to_rational/2,
/** Arithmetic predicates
These predicates are additions to standard the arithmetic functions provided by `is/2`.
*/
:- module(arithmetic, [expmod/4, lcm/3, lsb/2, msb/2, number_to_rational/2,
number_to_rational/3, popcount/2,
rational_numerator_denominator/3]).
@@ -6,6 +11,10 @@
:- use_module(library(error)).
:- use_module(library(lists), [append/3, member/2]).
%% expmod(+Base, +Expo, +Mod, -R).
%
% Modular exponentiation. Base, Expo and Mod must be integers.
expmod(Base, Expo, Mod, R) :-
( member(N, [Base, Expo, Mod]), var(N) -> instantiation_error(expmod/4)
; member(N, [Base, Expo, Mod]), \+ integer(N) ->
@@ -28,6 +37,25 @@ expmod_(Base0, Expo0, Mod, C, R) :-
Base is (Base0 * Base0) mod Mod,
expmod_(Base, Expo, Mod, C, R).
%% lcm(+A, +B, -Lcm) is det.
%
% Calculates the Least common multiple for A and B: the smallest positive integer
% that is divisible by both A and B.
%
% A and B need to be integers.
lcm(A, B, X) :-
builtins:must_be_number(A, lcm/2),
builtins:must_be_number(B, lcm/2),
( \+ integer(A) -> type_error(integer, A, lcm/2)
; \+ integer(B) -> type_error(integer, B, lcm/2)
; (A = 0, B = 0) -> X = 0
; builtins:can_be_number(X, lcm/2),
X is abs(B) // gcd(A,B) * abs(A)
).
%% lsb(+X, -N).
%
% True iff N is the least significat bit of integer X
lsb(X, N) :-
builtins:must_be_number(X, lsb/2),
( \+ integer(X) -> type_error(integer, X, lsb/2)
@@ -37,6 +65,9 @@ lsb(X, N) :-
msb_(X1, -1, N)
).
%% msb(+X, -N).
%
% True iff N is the most significant bit of integer X
msb(X, N) :-
builtins:must_be_number(X, msb/2),
( \+ integer(X) -> type_error(integer, X, msb/2)
@@ -52,6 +83,9 @@ msb_(X, M, N) :-
M1 is M + 1,
msb_(X1, M1, N).
%% number_to_rational(+Real, -Fraction).
%
% True iff given a number Real, Fraction is the same number represented as a fraction.
number_to_rational(Real, Fraction) :-
( var(Real) -> instantiation_error(number_to_rational/2)
; integer(Real) -> Fraction is Real rdiv 1
@@ -110,12 +144,20 @@ simplify_fraction(A0/B0, A/B) :-
A is A0 // G,
B is B0 // G.
%% rational_numerator_denominator(+Fraction, -Numerator, -Denominator).
%
% True iff given a fraction Fraction, Numerator is the numerator of that fraction
% and Denominator the denominator.
rational_numerator_denominator(R, N, D) :-
write_term_to_chars(R, [], Cs),
append(Ns, [' ', r, d, i, v, ' '|Ds], Cs),
number_chars(N, Ns),
number_chars(D, Ds).
%% popcount(+Number, -Bits1).
%
% True iff given an integer Number, Bits1 is the amount of 1 bits the binary representation
% of that number has.
popcount(X, N) :-
must_be(integer, X),
'$popcount'(X, N).

View File

@@ -54,28 +54,27 @@
:- use_module(library(lists)).
/** <module> Binary associations
/** Binary associations
Assocs are Key-Value associations implemented as a balanced binary tree
(AVL tree).
@see library(pairs), library(rbtrees)
@author R.A.O'Keefe, L.Damas, V.S.Costa and Jan Wielemaker
Authors: R.A.O'Keefe, L.Damas, V.S.Costa and Jan Wielemaker
*/
:- meta_predicate map_assoc(1, ?).
:- meta_predicate map_assoc(2, ?, ?).
%! empty_assoc(?Assoc) is semidet.
%% empty_assoc(?Assoc) is semidet.
%
% Is true if Assoc is the empty association list.
% Is true if Assoc is the empty association list.
empty_assoc(t).
%! assoc_to_list(+Assoc, -Pairs) is det.
%% assoc_to_list(+Assoc, -Pairs) is det.
%
% Translate Assoc to a list Pairs of Key-Value pairs. The keys
% in Pairs are sorted in ascending order.
% Translate Assoc to a list Pairs of Key-Value pairs. The keys
% in Pairs are sorted in ascending order.
assoc_to_list(Assoc, List) :-
assoc_to_list(Assoc, List, []).
@@ -86,10 +85,10 @@ assoc_to_list(t(Key,Val,_,L,R), List, Rest) :-
assoc_to_list(t, List, List).
%! assoc_to_keys(+Assoc, -Keys) is det.
%% assoc_to_keys(+Assoc, -Keys) is det.
%
% True if Keys is the list of keys in Assoc. The keys are sorted
% in ascending order.
% True if Keys is the list of keys in Assoc. The keys are sorted
% in ascending order.
assoc_to_keys(Assoc, List) :-
assoc_to_keys(Assoc, List, []).
@@ -100,11 +99,11 @@ assoc_to_keys(t(Key,_,_,L,R), List, Rest) :-
assoc_to_keys(t, List, List).
%! assoc_to_values(+Assoc, -Values) is det.
%% assoc_to_values(+Assoc, -Values) is det.
%
% True if Values is the list of values in Assoc. Values are
% ordered in ascending order of the key to which they were
% associated. Values may contain duplicates.
% True if Values is the list of values in Assoc. Values are
% ordered in ascending order of the key to which they were
% associated. Values may contain duplicates.
assoc_to_values(Assoc, List) :-
assoc_to_values(Assoc, List, []).
@@ -114,12 +113,12 @@ assoc_to_values(t(_,Value,_,L,R), List, Rest) :-
assoc_to_values(R, More, Rest).
assoc_to_values(t, List, List).
%! is_assoc(+Assoc) is semidet.
%% is_assoc(+Assoc) is semidet.
%
% True if Assoc is an association list. This predicate checks
% that the structure is valid, elements are in order, and tree
% is balanced to the extent guaranteed by AVL trees. I.e.,
% branches of each subtree differ in depth by at most 1.
% True if Assoc is an association list. This predicate checks
% that the structure is valid, elements are in order, and tree
% is balanced to the extent guaranteed by AVL trees. I.e.,
% branches of each subtree differ in depth by at most 1.
is_assoc(Assoc) :-
is_assoc(Assoc, _Min, _Max, _Depth).
@@ -151,12 +150,10 @@ balance(=,-).
balance(<,<).
balance(>,>).
%! gen_assoc(?Key, +Assoc, ?Value) is nondet.
%% gen_assoc(?Key, +Assoc, ?Value) is nondet.
%
% True if Key-Value is an association in Assoc. Enumerates keys in
% ascending order on backtracking.
%
% @see get_assoc/3.
% True if Key-Value is an association in Assoc. Enumerates keys in
% ascending order on backtracking.
gen_assoc(Key, Assoc, Value) :-
( ground(Key)
@@ -171,11 +168,11 @@ gen_assoc_(Key, t(_,_,_,_,R), Val) :-
gen_assoc_(Key, R, Val).
%! get_assoc(+Key, +Assoc, -Value) is semidet.
%% get_assoc(+Key, +Assoc, -Value) is semidet.
%
% True if Key-Value is an association in Assoc.
% True if Key-Value is an association in Assoc.
%
% @error type_error(assoc, Assoc) if Assoc is not an association list.
% Throws error: `type_error(assoc, Assoc)` if Assoc is not an association list.
get_assoc(Key, Assoc, Val) :-
must_be(assoc, Assoc),
@@ -201,9 +198,9 @@ get_assoc(>, Key, _, _, Tree, Val) :-
% :- endif.
%! get_assoc(+Key, +Assoc0, ?Val0, ?Assoc, ?Val) is semidet.
%% get_assoc(+Key, +Assoc0, ?Val0, ?Assoc, ?Val) is semidet.
%
% True if Key-Val0 is in Assoc0 and Key-Val is in Assoc.
% True if Key-Val0 is in Assoc0 and Key-Val is in Assoc.
get_assoc(Key, t(K,V,B,L,R), Val, t(K,NV,B,NL,NR), NVal) :-
compare(Rel, Key, K),
@@ -216,12 +213,12 @@ get_assoc(>, Key, V, L, R, Val, V, L, NR, NVal) :-
get_assoc(Key, R, Val, NR, NVal).
%! list_to_assoc(+Pairs, -Assoc) is det.
%% list_to_assoc(+Pairs, -Assoc) is det.
%
% Create an association from a list Pairs of Key-Value pairs. List
% must not contain duplicate keys.
% Create an association from a list Pairs of Key-Value pairs. List
% must not contain duplicate keys.
%
% @error domain_error(unique_key_pairs, List) if List contains duplicate keys
% Throws error: `domain_error(unique_key_pairs, List)` if List contains duplicate keys
list_to_assoc(List, Assoc) :-
( List = [] -> Assoc = t
@@ -246,13 +243,13 @@ list_to_assoc(N, List, More, Depth, t(K,V,Balance,L,R)) :-
compare(B, RDepth, LDepth),
balance(B, Balance).
%! ord_list_to_assoc(+Pairs, -Assoc) is det.
%% ord_list_to_assoc(+Pairs, -Assoc) is det.
%
% Assoc is created from an ordered list Pairs of Key-Value
% pairs. The pairs must occur in strictly ascending order of
% their keys.
% Assoc is created from an ordered list Pairs of Key-Value
% pairs. The pairs must occur in strictly ascending order of
% their keys.
%
% @error domain_error(key_ordered_pairs, List) if pairs are not ordered.
% Throws error: `domain_error(key_ordered_pairs, List)` if pairs are not ordered.
ord_list_to_assoc(Sorted, Assoc) :-
( Sorted = [] -> Assoc = t
@@ -263,9 +260,9 @@ ord_list_to_assoc(Sorted, Assoc) :-
)
).
%! ord_pairs(+Pairs) is semidet
%% ord_pairs(+Pairs) is semidet
%
% True if Pairs is a list of Key-Val pairs strictly ordered by key.
% True if Pairs is a list of Key-Val pairs strictly ordered by key.
ord_pairs([K-_V|Rest]) :-
ord_pairs(Rest, K).
@@ -274,9 +271,9 @@ ord_pairs([K-_V|Rest], K0) :-
K0 @< K,
ord_pairs(Rest, K).
%! map_assoc(:Pred, +Assoc) is semidet.
%% map_assoc(:Pred, +Assoc) is semidet.
%
% True if Pred(Value) is true for all values in Assoc.
% True if Pred(Value) is true for all values in Assoc.
map_assoc(Pred, T) :-
map_assoc_(T, Pred).
@@ -287,10 +284,10 @@ map_assoc_(t(_,Val,_,L,R), Pred) :-
call(Pred, Val),
map_assoc_(R, Pred).
%! map_assoc(:Pred, +Assoc0, ?Assoc) is semidet.
%% map_assoc(:Pred, +Assoc0, ?Assoc) is semidet.
%
% Map corresponding values. True if Assoc is Assoc0 with Pred
% applied to all corresponding pairs of of values.
% Map corresponding values. True if Assoc is Assoc0 with Pred
% applied to all corresponding pairs of of values.
map_assoc(Pred, T0, T) :-
map_assoc_(T0, Pred, T).
@@ -302,9 +299,9 @@ map_assoc_(t(Key,Val,B,L0,R0), Pred, t(Key,Ans,B,L1,R1)) :-
map_assoc_(R0, Pred, R1).
%! max_assoc(+Assoc, -Key, -Value) is semidet.
%% max_assoc(+Assoc, -Key, -Value) is semidet.
%
% True if Key-Value is in Assoc and Key is the largest key.
% True if Key-Value is in Assoc and Key is the largest key.
max_assoc(t(K,V,_,_,R), Key, Val) :-
max_assoc(R, K, V, Key, Val).
@@ -314,9 +311,9 @@ max_assoc(t(K,V,_,_,R), _, _, Key, Val) :-
max_assoc(R, K, V, Key, Val).
%! min_assoc(+Assoc, -Key, -Value) is semidet.
%% min_assoc(+Assoc, -Key, -Value) is semidet.
%
% True if Key-Value is in assoc and Key is the smallest key.
% True if Key-Value is in assoc and Key is the smallest key.
min_assoc(t(K,V,_,L,_), Key, Val) :-
min_assoc(L, K, V, Key, Val).
@@ -326,10 +323,10 @@ min_assoc(t(K,V,_,L,_), _, _, Key, Val) :-
min_assoc(L, K, V, Key, Val).
%! put_assoc(+Key, +Assoc0, +Value, -Assoc) is det.
%% put_assoc(+Key, +Assoc0, +Value, -Assoc) is det.
%
% Assoc is Assoc0, except that Key is associated with
% Value. This can be used to insert and change associations.
% Assoc is Assoc0, except that Key is associated with
% Value. This can be used to insert and change associations.
put_assoc(Key, A0, Value, A) :-
insert(A0, Key, Value, A, _).
@@ -361,11 +358,11 @@ table(< , right , - , no , no ) :- !.
table(> , left , - , no , no ) :- !.
table(> , right , - , no , yes ) :- !.
%! del_min_assoc(+Assoc0, ?Key, ?Val, -Assoc) is semidet.
%% del_min_assoc(+Assoc0, ?Key, ?Val, -Assoc) is semidet.
%
% True if Key-Value is in Assoc0 and Key is the smallest key.
% Assoc is Assoc0 with Key-Value removed. Warning: This will
% succeed with _no_ bindings for Key or Val if Assoc0 is empty.
% True if Key-Value is in Assoc0 and Key is the smallest key.
% Assoc is Assoc0 with Key-Value removed. Warning: This will
% succeed with _no_ bindings for Key or Val if Assoc0 is empty.
del_min_assoc(Tree, Key, Val, NewTree) :-
del_min_assoc(Tree, Key, Val, NewTree, _DepthChanged).
@@ -375,11 +372,11 @@ del_min_assoc(t(K,V,B,L,R), Key, Val, NewTree, Changed) :-
del_min_assoc(L, Key, Val, NewL, LeftChanged),
deladjust(LeftChanged, t(K,V,B,NewL,R), left, NewTree, Changed).
%! del_max_assoc(+Assoc0, ?Key, ?Val, -Assoc) is semidet.
%% del_max_assoc(+Assoc0, ?Key, ?Val, -Assoc) is semidet.
%
% True if Key-Value is in Assoc0 and Key is the greatest key.
% Assoc is Assoc0 with Key-Value removed. Warning: This will
% succeed with _no_ bindings for Key or Val if Assoc0 is empty.
% True if Key-Value is in Assoc0 and Key is the greatest key.
% Assoc is Assoc0 with Key-Value removed. Warning: This will
% succeed with _no_ bindings for Key or Val if Assoc0 is empty.
del_max_assoc(Tree, Key, Val, NewTree) :-
del_max_assoc(Tree, Key, Val, NewTree, _DepthChanged).
@@ -389,10 +386,10 @@ del_max_assoc(t(K,V,B,L,R), Key, Val, NewTree, Changed) :-
del_max_assoc(R, Key, Val, NewR, RightChanged),
deladjust(RightChanged, t(K,V,B,L,NewR), right, NewTree, Changed).
%! del_assoc(+Key, +Assoc0, ?Value, -Assoc) is semidet.
%% del_assoc(+Key, +Assoc0, ?Value, -Assoc) is semidet.
%
% True if Key-Value is in Assoc0. Assoc is Assoc0 with
% Key-Value removed.
% True if Key-Value is in Assoc0. Assoc is Assoc0 with
% Key-Value removed.
del_assoc(Key, A0, Value, A) :-
delete(A0, Key, Value, A, _).

View File

@@ -19,77 +19,12 @@
'$default_attr_list'(PGs, Module, AttrVar).
'$default_attr_list'([], _, _) --> [].
'$absent_attr'(V, Attr) :-
'$get_attr_list'(V, Ls),
'$absent_from_list'(Ls, Attr).
'$absent_from_list'(X, 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_from_list'([L|Ls], V, Attr) :-
nonvar(L),
( 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).
'$add_to_list'(Ls, V, Attr) :-
( var(Ls) ->
Ls = [Attr | _],
'$enqueue_attr_var'(V)
; Ls = [_ | Ls0],
'$add_to_list'(Ls0, V, Attr)
).
'$del_attr'(Ls0, _, _) :-
var(Ls0),
!.
'$del_attr'(Ls0, V, Attr) :-
Ls0 = [Att | Ls1],
nonvar(Att),
( Att \= Attr ->
'$del_attr_buried'(Ls0, Ls1, V, Attr)
; '$enqueue_attr_var'(V),
'$del_attr_head'(V),
'$del_attr'(Ls1, V, Attr)
).
'$del_attr_step'(Ls1, V, Attr) :-
( nonvar(Ls1) ->
Ls1 = [_ | Ls2],
'$del_attr_buried'(Ls1, Ls2, V, Attr)
'$absent_attr'(V, Module, Attr) :-
( '$get_from_attr_list'(V, Module, Attr) ->
false
; true
).
%% assumptions: Ls0 is a list, Ls1 is its tail;
%% the head of Ls0 can be ignored.
'$del_attr_buried'(Ls0, Ls1, V, Attr) :-
( var(Ls1) -> true
; Ls1 = [Att | Ls2] ->
( Att \= Attr ->
'$del_attr_buried'(Ls1, Ls2, V, Attr)
; '$enqueue_attr_var'(V),
'$del_attr_non_head'(Ls0), %% set tail of Ls0 = tail of Ls1. can be undone by backtracking.
'$del_attr_step'(Ls1, V, Attr)
)
).
'$copy_attr_list'(L, _Module, []) :- var(L), !.
'$copy_attr_list'([Module0:Att|Atts], Module, CopiedAtts) :-
( Module0 == Module ->
@@ -145,38 +80,28 @@ put_attr(Name, Arity, Module) -->
{ functor(Attr, Name, Arity) },
[(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)),
(put_atts(V, Attr) :-
'$put_to_attr_list'(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)),
'$put_to_attr_list'(V, Module, Attr)),
(put_atts(V, -Attr) :-
!,
functor(Attr, _, _),
'$get_attr_list'(V, Ls),
atts:'$del_attr'(Ls, V, Module:Attr))].
'$del_from_attr_list'(V, Module, Attr))].
get_attr(Name, Arity, Module) -->
{ functor(Attr, Name, Arity) },
[(get_atts(V, +Attr) :-
!,
functor(Attr, _, _),
atts:'$get_attr'(V, Module:Attr)),
atts:'$get_from_attr_list'(V, Module, Attr)),
(get_atts(V, Attr) :-
!,
functor(Attr, _, _),
atts:'$get_attr'(V, Module:Attr)),
atts:'$get_from_attr_list'(V, Module, Attr)),
(get_atts(V, -Attr) :-
!,
functor(Attr, _, _),
atts:'$absent_attr'(V, Module:Attr))].
atts:'$absent_attr'(V, Module, Attr))].
user:goal_expansion(Term, M:put_atts(Var, Attr)) :-
nonvar(Term),

View File

@@ -1,3 +1,10 @@
/** Predicates that generate integers
These predicates can be used to reason about integers in a reduced domain that
follow some property. `library(clpz)` provides another way of reasoning about
integers that may also be interesting.
*/
:- module(between, [between/3, gen_int/1, gen_nat/1, numlist/2, numlist/3, repeat/1]).
%% TODO: numlist/5.
@@ -5,6 +12,24 @@
:- use_module(library(lists), [length/2]).
:- use_module(library(error)).
%% between(+Lower, +Upper, -X).
%
% Given Lower and Upper are both integer numbers, true iff X is an integer so that _Lower =< X =< Upper_.
% Can be used both to check if X is between Lower and Upper or to generate an integer between
% Lower and Upper.
%
% Examples:
%
% ```
% ?- between(10, 20, 15).
% true.
% ?- between(10, 20, 25).
% false.
% ?- between(3, 5, X).
% X = 3
% ; X = 4
% ; X = 5.
% ```
between(Lower, Upper, X) :-
must_be(integer, Lower),
must_be(integer, Upper),
@@ -30,6 +55,9 @@ enumerate_nats(I0, N) :-
I1 is I0 + 1,
enumerate_nats(I1, N).
%% gen_nat(?N)
%
% True iff N is a natural number.
gen_nat(N) :-
can_be(integer, N),
( var(N) -> enumerate_nats(0, N)
@@ -44,6 +72,9 @@ enumerate_ints(I0, N) :-
I1 is I0 + 1,
enumerate_ints(I1, N).
%% gen_int(?N)
%
% True iff N is an integer.
gen_int(N) :-
can_be(integer, N),
( var(N) -> enumerate_ints(0, N)
@@ -55,9 +86,24 @@ repeat_integer(N) :-
repeat_integer(N0) :-
N0 > 0, N1 is N0 - 1, repeat_integer(N1).
%% repeat(+N)
%
% Succeeds N times. This predicate is only included for compatibility and *should not be used*
% because it lacks a declarative interpretation.
repeat(N) :-
must_be(integer, N), repeat_integer(N).
%% numlist(?Upper, ?List)
%
% True iff List is the list of integers _[1, ..., Upper]_. Example:
%
% ```
% ?- numlist(X, Y).
% X = 1, Y = [1],
% ; X = 2, Y = [1,2]
% ; X = 3, Y = [1,2,3]
% ; ... .
% ```
numlist(Upper, List) :-
( integer(Upper) -> findall(X, between(1, Upper, X), List)
; List = [_|_], length(List, Upper), findall(X, between(1, Upper, X), List)
@@ -106,5 +152,14 @@ gen_ints(L, U) :-
),
L =< U.
%% numlist(?Lower, ?Upper, ?List).
%
% True iff List is a list of the form _[Lower, ..., Upper]_.
% Example:
%
% ```
% ?- numlist(5, 10, X).
% X = [5,6,7,8,9,10].
% ```
numlist(Lower, Upper, List) :-
gen_ints(Lower, Upper), findall(X, between(Lower, Upper, X), List).

File diff suppressed because it is too large Load Diff

View File

@@ -1,9 +1,18 @@
/** High-level predicates to work with chars and strings
This module contains predicates that relates strings of chars
to other representations, as well as high-level predicates to
read and write chars.
*/
:- module(charsio, [char_type/2,
chars_utf8bytes/2,
get_single_char/1,
get_n_chars/3,
read_line_to_chars/3,
get_line_to_chars/3,
read_from_chars/2,
read_term_from_chars/3,
write_term_to_chars/3,
chars_base64/3]).
@@ -65,6 +74,63 @@ extend_var_list_([V|Vs], N, VarList, NewVarList, VarType) :-
).
%% char_type(+Char, -Type).
%
% Given a Char, Type is one of the categories that char fits in.
% Possible categories are:
%
% - `alnum`
% - `alpha`
% - `alphabetic`
% - `alphanumeric`
% - `ascii`
% - `ascii_graphic`
% - `ascii_punctuation`
% - `binary_digit`
% - `control`
% - `decimal_digit`
% - `exponent`
% - `graphic`
% - `graphic_token`
% - `hexadecimal_digit`
% - `layout`
% - `lower`
% - `meta`
% - `numeric`
% - `octal_digit`
% - `octet`
% - `prolog`
% - `sign`
% - `solo`
% - `symbolic_control`
% - `symbolic_hexadecimal`
% - `upper`
% - `lower(Lower)`
% - `upper(Upper)`
% - `whitespace`
%
% An example:
%
% ```
% ?- char_type(a, Type).
% Type = alnum
% ; Type = alpha
% ; Type = alphabetic
% ; Type = alphanumeric
% ; Type = ascii
% ; Type = ascii_graphic
% ; Type = hexadecimal_digit
% ; Type = lower
% ; Type = octet
% ; Type = prolog
% ; Type = symbolic_control
% ; Type = lower("a")
% ; Type = upper("A")
% ; false.
% ```
%
% Note that uppercase and lowercase transformations use a string. This is because
% some characters do not map 1:1 between lowercase and uppercase.
char_type(Char, Type) :-
must_be(character, Char),
( ground(Type) ->
@@ -102,27 +168,68 @@ ctype(sign).
ctype(solo).
ctype(symbolic_control).
ctype(symbolic_hexadecimal).
ctype(lower(_)).
ctype(upper(_)).
ctype(upper).
ctype(whitespace).
%% get_single_char(-Char).
%
% Gets a single char from the current input stream.
get_single_char(C) :-
( var(C) -> '$get_single_char'(C)
; atom_length(C, 1) -> '$get_single_char'(C)
; type_error(in_character, C, get_single_char/1)
).
%% read_from_chars(+Chars, -Term).
%
% Given a string made of chars which contains a representation of
% a Prolog term, Term is the Prolog term represented. Example:
%
% ```
% ?- read_from_chars("f(x,y).", X).
% X = f(x,y).
% ```
read_from_chars(Chars, Term) :-
must_be(chars, Chars),
'$read_term_from_chars'(Chars, Term).
must_be(var, Term),
'$read_from_chars'(Chars, Term).
%% read_term_from_chars(+Chars, -Term, +Options).
%
% Like `read_from_chars`, except the reader is configured according to
% `Options` which are those of `read_term`.
%
% ```
% ?- read_term_from_chars("f(X,y).", T, [variable_names(['X'=X])]).
% T = f(X,y).
% ```
read_term_from_chars(Chars, Term, Options) :-
must_be(chars, Chars),
must_be(var, Term),
builtins:parse_read_term_options(Options, [Singletons, VariableNames, Variables], read_term_from_chars/3),
'$read_term_from_chars'(Chars, Term, Singletons, Variables, VariableNames).
%% write_term_to_chars(+Term, +Options, -Chars).
%
% Given a Term which is a Prolog term and a set of options, Chars is
% string representation of that term. Options available are:
%
% * `ignore_ops(+Boolean)` if `true`, the generic term representation is used everywhere. In `false`
% (default), operators do not use that generic term representation.
% * `max_depth(+N)` if the term is nested deeper than N, print the reminder as ellipses.
% If N = 0 (default), there's no limit.
% * `numbervars(+Boolean)` if true, replaces `$VAR(N)` variables with letters, in order. Default is false.
% * `quoted(+Boolean)` if true, strings and atoms that need quotes to be valid Prolog syntax, are quoted. Default is false.
% * `variable_names(+List)` assign names to variables in term. List should be a list of terms of format `Name=Var`.
% * `double_quotes(+Boolean)` if true, strings are printed in double quotes rather than with list notation. Default is false.
write_term_to_chars(_, Options, _) :-
var(Options), instantiation_error(write_term_to_chars/3).
write_term_to_chars(Term, Options, Chars) :-
builtins:parse_write_options(Options,
[IgnoreOps, MaxDepth, NumberVars, Quoted, VNNames],
[DoubleQuotes, IgnoreOps, MaxDepth, NumberVars, Quoted, VNNames],
write_term_to_chars/3),
( nonvar(Chars) ->
throw(error(uninstantiation_error(Chars), write_term_to_chars/3))
@@ -131,7 +238,7 @@ write_term_to_chars(Term, Options, Chars) :-
),
term_variables(Term, Vars),
extend_var_list(Vars, VNNames, NewVarNames, numbervars),
'$write_term_to_chars'(Chars, Term, IgnoreOps, NumberVars, Quoted, NewVarNames, MaxDepth).
'$write_term_to_chars'(Chars, Term, IgnoreOps, NumberVars, Quoted, NewVarNames, MaxDepth, DoubleQuotes).
% Encodes Ch character to list of Bytes.
char_utf8bytes(Ch, Bytes) :-
@@ -151,6 +258,17 @@ encode(Code, Prefix, Nb) -->
% Maps characters and UTF-8 bytes.
% If Cs is a variable, parses Bs as a list of UTF-8 bytes.
% Otherwise, transform the list of characters Cs to UTF-8 bytes.
%% chars_utf8bytes(?Chars, ?Bytes).
%
% Maps a string made of chars with a list of UTF-8 bytes. Some examples:
%
% ```
% ?- chars_utf8bytes("Prolog", X).
% X = [80,114,111,108,111,103].
% ?- chars_utf8bytes(X, [226, 136, 145]).
% X = "∑".
% ```
chars_utf8bytes(Cs, Bs) :-
var(Cs), must_be(list, Bs) ->
once(phrase(decode_utf8(Cs), Bs))
@@ -177,58 +295,66 @@ continuation(Code, Chars, Nb) --> [Byte],
% each remaining continuation byte (if any) will raise 0xFFFD too
continuation(_, ['\xFFFD\'|T], _) --> [_], decode_utf8(T).
read_line_to_chars(Stream, Cs0, Cs) :-
%% get_line_to_chars(+Stream, -Chars, +InitialChars).
%
% Reads chars from stream Stream until it finds a `\n` character.
% InitialChars will be appended at the end of Chars
get_line_to_chars(Stream, Cs0, Cs) :-
'$get_n_chars'(Stream, 1, Char), % this also works for binary streams
( Char == [] -> Cs0 = Cs
; Char = [C],
Cs0 = [C|Rest],
( C == '\n' -> Rest = Cs
; read_line_to_chars(Stream, Rest, Cs)
; get_line_to_chars(Stream, Rest, Cs)
)
).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Read N characters from Stream.
If N is a variable, read until EOF, unifying N with the number of
characters read.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
%% get_n_chars(+Stream, ?N, -Chars).
%
% Read N chars from stream Stream. N can be an integer, in that case
% only N chars are read, or a variable, unifying N with the number of chars
% read until it found EOF.
get_n_chars(Stream, N, Cs) :-
can_be(integer, N),
( var(N) ->
read_to_eof(Stream, Cs),
get_to_eof(Stream, Cs),
length(Cs, N)
; N >= 0,
'$get_n_chars'(Stream, N, Cs)
).
read_to_eof(Stream, Cs) :-
'$get_n_chars'(Stream, 512, Cs0),
get_n_chars_wrapper(Stream, N, Cs) :-
'$get_n_chars'(Stream, N, Cs).
get_to_eof(Stream, Cs) :-
catch(get_n_chars_wrapper(Stream, 512, Cs0),
error(syntax_error(unexpected_end_of_file), _),
Cs0 = []),
( Cs0 == [] -> Cs = []
; partial_string(Cs0, Cs, Rest),
read_to_eof(Stream, Rest)
get_to_eof(Stream, Rest)
).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Relation between a list of characters Cs and its Base64 encoding Bs,
also a list of characters.
At least one of the arguments must be instantiated.
Options are:
- padding(Boolean)
Whether to use padding: true (the default) or false.
- charset(C)
Either 'standard' (RFC 4648 §4, the default) or 'url' (RFC 4648 §5).
Example:
?- chars_base64("hello", Bs, []).
Bs = "aGVsbG8=".
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
%% chars_base64(?Chars, ?Base64, +Options).
%
% Relation between a list of characters Cs and its Base64 encoding Bs,
% also a list of characters.
%
% At least one of the arguments must be instantiated.
%
% Options are:
%
% - `padding(Boolean)`
% Whether to use padding: true (the default) or false.
% - `charset(C)`
% Either 'standard' (RFC 4648 §4, the default) or 'url' (RFC 4648 §5).
%
% Example:
%
% ```
% ?- chars_base64("hello", Bs, []).
% Bs = "aGVsbG8=".
% ```
chars_base64(Cs, Bs, Options) :-
must_be(list, Options),

View File

@@ -1,10 +1,29 @@
/* CLP(B): Constraint Logic Programming over Boolean Variables
Copyright (C): 2019 Markus Triska
All rights reserved.
Author: Markus Triska
E-mail: triska@metalevel.at
WWW: http://www.metalevel.at
WWW: https://www.metalevel.at
Copyright (C): 2019-2023 Markus Triska
Permission is hereby granted, free of charge, to any person
obtaining a copy of this software and associated documentation
files (the "Software"), to deal in the Software without
restriction, including without limitation the rights to use, copy,
modify, merge, publish, distribute, sublicense, and/or sell copies
of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be
included in all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
DEALINGS IN THE SOFTWARE.
*/
@@ -17,8 +36,8 @@
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
:- module(clpb, [op(300, fy, ~),
op(500, yfx, #),
sat/1,
op(500, yfx, #),
sat/1,
taut/2,
labeling/1,
sat_count/2,
@@ -91,6 +110,46 @@ domain_error(Expectation, Term) :-
type_error(Expectation, Term) :-
type_error(Expectation, Term, unknown(Term)-1).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Compatibility predicates.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
:- meta_predicate(include(1, ?, ?)).
include(_, [], []).
include(Goal, [L|Ls0], Ls) :-
( call(Goal, L) ->
Ls = [L|Rest]
; Ls = Rest
),
include(Goal, Ls0, Rest).
:- meta_predicate(exclude(1, ?, ?)).
exclude(_, [], []).
exclude(Goal, [L|Ls0], Ls) :-
( call(Goal, L) ->
Ls = Rest
; Ls = [L|Rest]
),
exclude(Goal, Ls0, Rest).
:- meta_predicate(partition(2,?,?,?,?)).
partition(_, [], [], [], []).
partition(Pred, [H|T], L, E, G) :-
call(Pred, H, Diff),
partition_(Diff, H, Pred, T, L, E, G).
partition_(<, H, Pred, T, [H|Rest], E, G) :-
partition(Pred, T, Rest, E, G).
partition_(=, H, Pred, T, L, [H|Rest], G) :-
partition(Pred, T, L, Rest, G).
partition_(>, H, Pred, T, L, E, [H|Rest]) :-
partition(Pred, T, L, E, Rest).
:- meta_predicate(partition(1,?,?,?)).
partition(Pred, Ls0, As, Bs) :-
include(Pred, Ls0, As),
exclude(Pred, Ls0, Bs).
@@ -105,6 +164,262 @@ goal_expansion(del_attr(Var, Module), (var(Var) -> put_atts(Var, -Access);true))
Access =.. [Module,_].
/** Constraint Logic Programming over Boolean variables
## Introduction
This library provides CLP(B), Constraint Logic Programming over
Boolean variables. It can be used to model and solve combinatorial
problems such as verification, allocation and covering tasks.
CLP(B) is an instance of the general CLP(_X_) scheme,
extending logic programming with reasoning over specialised domains.
The implementation is based on reduced and ordered Binary Decision
Diagrams (BDDs).
Benchmarks and usage examples of this library are available from:
[*https://www.metalevel.at/clpb/*](https://www.metalevel.at/clpb/)
## Boolean expressions
A _Boolean expression_ is one of:
| `0` | false |
| `1` | true |
| _variable_ | unknown truth value |
| _atom_ | universally quantified variable |
| ~ _Expr_ | logical NOT |
| _Expr_ + _Expr_ | logical OR |
| _Expr_ * _Expr_ | logical AND |
| _Expr_ # _Expr_ | exclusive OR |
| _Var_ ^ _Expr_ | existential quantification |
| _Expr_ =:= _Expr_ | equality |
| _Expr_ =\= _Expr_ | disequality (same as #) |
| _Expr_ =< _Expr_ | less or equal (implication) |
| _Expr_ >= _Expr_ | greater or equal |
| _Expr_ < _Expr_ | less than |
| _Expr_ > _Expr_ | greater than |
| card(Is,Exprs) | cardinality constraint (_see below_) |
| `+(Exprs)` | n-fold disjunction (_see below_) |
| `*(Exprs)` | n-fold conjunction (_see below_) |
where _Expr_ again denotes a Boolean expression.
The Boolean expression `card(Is,Exprs)` is true iff the number of true
expressions in the list `Exprs` is a member of the list `Is` of
integers and integer ranges of the form `From-To`. For example, to
state that precisely two of the three variables `X`, `Y` and `Z` are
`true`, you can use `sat(card([2],[X,Y,Z]))`.
`+(Exprs)` and `*(Exprs)` denote, respectively, the disjunction and
conjunction of all elements in the list `Exprs` of Boolean
expressions.
Atoms denote parametric values that are universally quantified. All
universal quantifiers appear implicitly in front of the entire
expression. In residual goals, universally quantified variables always
appear on the right-hand side of equations. Therefore, they can be
used to express functional dependencies on input variables.
## Interface predicates
The most frequently used CLP(B) predicates are:
* `sat(+Expr)`
True iff the Boolean expression Expr is satisfiable.
* `taut(+Expr, -T)`
If Expr is a tautology with respect to the posted constraints, succeeds
with *T = 1*. If Expr cannot be satisfied, succeeds with *T = 0*.
Otherwise, it fails.
* `labeling(+Vs)`
Assigns truth values to the variables Vs such that all constraints
are satisfied.
The unification of a CLP(B) variable _X_ with a term _T_ is equivalent
to posting the constraint sat(X=:=T).
## Examples
Here is an example session with a few queries and their answers:
```
?- use_module(library(clpb)).
true.
?- sat(X*Y).
X = 1, Y = 1.
?- sat(X * ~X).
false.
?- taut(X * ~X, T).
T = 0, clpb:sat(X=:=X).
?- sat(X^Y^(X+Y)).
clpb:sat(X=:=X), clpb:sat(Y=:=Y).
?- sat(X*Y + X*Z), labeling([X,Y,Z]).
X = 1, Y = 0, Z = 1
; X = 1, Y = 1, Z = 0
; X = 1, Y = 1, Z = 1.
?- sat(X =< Y), sat(Y =< Z), taut(X =< Z, T).
T = 1, clpb:sat(X=:=X*Y), clpb:sat(Y=:=Y*Z).
?- sat(1#X#a#b).
clpb:sat(X=:=a#b).
```
The pending residual goals constrain remaining variables to Boolean
expressions and are declaratively equivalent to the original query.
The last example illustrates that when applicable, remaining variables
are expressed as functions of universally quantified variables.
## Obtaining BDDs
By default, CLP(B) residual goals appear in (approximately) algebraic
normal form (ANF). This projection is often computationally expensive.
We can assert `clpb:clpb_residuals(bdd)` to see the BDD representation
of all constraints. This results in faster projection to residual
goals, and is also useful for learning more about BDDs. For example:
```
?- asserta(clpb:clpb_residuals(bdd)).
true.
?- sat(X#Y).
node(3)- (v(X, 0)->node(2);node(1)),
node(1)- (v(Y, 1)->true;false),
node(2)- (v(Y, 1)->false;true).
```
Note that this representation cannot be pasted back on the toplevel,
and its details are subject to change. Use copy_term/3 to obtain
such answers as Prolog terms.
The variable order of the BDD is determined by the order in which the
variables first appear in constraints. To obtain different orders,
we can for example use:
```
?- sat(+[1,Y,X]), sat(X#Y).
node(3)- (v(Y, 0)->node(2);node(1)),
node(1)- (v(X, 1)->true;false),
node(2)- (v(X, 1)->false;true).
```
## Enabling monotonic CLP(B)
In the default execution mode, CLP(B) constraints are _not_ monotonic.
This means that _adding_ constraints can yield new solutions. For
example:
```
?- sat(X=:=1), X = 1+0.
false.
?- X = 1+0, sat(X=:=1), X = 1+0.
X = 1+0.
```
This behaviour is highly problematic from a logical point of view, and
it may render [*declarative
debugging*](https://www.metalevel.at/prolog/debugging)
techniques inapplicable.
Assert `clpb:monotonic` to make CLP(B) *monotonic*. If this mode is
enabled, then you must wrap CLP(B) variables with the functor
`v/1`. For example:
```
?- asserta(clpb:monotonic).
true.
?- sat(v(X)=:=1#1).
X = 0.
```
## Example: Pigeons
In this example, we are attempting to place _I_ pigeons into _J_ holes
in such a way that each hole contains at most one pigeon. One
interesting property of this task is that it can be formulated using
only _cardinality constraints_ (`card/2`). Another interesting aspect
is that this task has no short resolution refutations in general.
In the following, we use [*Prolog DCG
notation*](https://www.metalevel.at/prolog/dcg) to describe a
list `Cs` of CLP(B) constraints that must all be satisfied.
```
:- use_module(library(clpb)).
:- use_module(library(clpz)).
:- use_module(library(lists)).
:- use_module(library(dcgs)).
pigeon(I, J, Rows, Cs) :-
length(Rows, I), length(Row, J),
maplist(same_length(Row), Rows),
transpose(Rows, TRows),
phrase((all_cards(Rows,[1]),all_cards(TRows,[0,1])), Cs).
all_cards([], _) --> [].
all_cards([Ls|Lss], Cs) --> [card(Cs,Ls)], all_cards(Lss, Cs).
```
Example queries:
```
?- pigeon(9, 8, Rows, Cs), sat(*(Cs)).
false.
?- pigeon(2, 3, Rows, Cs), sat(*(Cs)),
append(Rows, Vs), labeling(Vs),
maplist(portray_clause, Rows).
[0,0,1].
[0,1,0].
etc.
```
## Example: Boolean circuit
Consider a Boolean circuit that express the Boolean function =|XOR|=
with 4 =|NAND|= gates. We can model such a circuit with CLP(B)
constraints as follows:
```
:- use_module(library(clpb)).
nand_gate(X, Y, Z) :- sat(Z =:= ~(X*Y)).
xor(X, Y, Z) :-
nand_gate(X, Y, T1),
nand_gate(X, T1, T2),
nand_gate(Y, T1, T3),
nand_gate(T2, T3, Z).
```
Using universally quantified variables, we can show that the circuit
does compute =|XOR|= as intended:
```
?- xor(x, y, Z).
clpb:sat(Z=:=x#y).
```
## Acknowledgments
The interface predicates of this library follow the example of
[*SICStus Prolog*](https://sicstus.sics.se).
Use SICStus Prolog for higher performance in many cases.
*/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Each CLP(B) variable belongs to exactly one BDD. Each CLP(B)
variable gets an attribute (in module "clpb") of the form:
@@ -191,6 +506,10 @@ non_monotonic(X) :-
; true
).
:- meta_predicate(bdd_nodes(1, ?, ?)).
:- meta_predicate(bdd_nodes_(1, ?, ?, ?)).
:- meta_predicate(with_aux(1, ?)).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Rewriting to canonical expressions.
Atoms are converted to variables with a special attribute.
@@ -1108,19 +1427,17 @@ indomain(1).
%
% Examples:
%
% ==
% ```
% ?- sat(A =< B), Vs = [A,B], sat_count(+[1|Vs], Count).
% Vs = [A, B],
% Count = 3,
% sat(A=:=A*B).
% Vs = [A,B], Count = 3, clpb:sat(A=:=A*B).
%
% ?- length(Vs, 120),
% sat_count(+Vs, CountOr),
% sat_count(*(Vs), CountAnd).
% Vs = [...],
% CountOr = 1329227995784915872903807060280344575,
% CountAnd = 1.
% ==
% Vs = [...],
% CountOr = 1329227995784915872903807060280344575,
% CountAnd = 1.
% ```
@@ -1248,7 +1565,7 @@ random_bindings(VNum, Node) -->
% linear objective function over Boolean variables Vs with integer
% coefficients Weights. This predicate assigns 0 and 1 to the
% variables in Vs such that all stated constraints are satisfied, and
% Maximum is the maximum of sum(Weight_i*V_i) over all admissible
% Maximum is the maximum of `sum(Weight_i*V_i)` over all admissible
% assignments. On backtracking, all admissible assignments that
% attain the optimum are generated.
%
@@ -1257,10 +1574,10 @@ random_bindings(VNum, Node) -->
%
% Example:
%
% ==
% ```
% ?- sat(A#B), weighted_maximum([1,2,1], [A,B,C], Maximum).
% A = 0, B = 1, C = 1, Maximum = 3.
% ==
% A = 0, B = 1, C = 1, Maximum = 3.
% ```
weighted_maximum(Ws, Vars, Max) :-
must_be(list(integer), Ws),
@@ -1373,14 +1690,14 @@ skip_to_var_(Var, Weight, [Var0-Weight0|VWs0], VWs) -->
attribute_goals(Var) -->
{ var_index_root(Var, _, Root) },
!,
( { root_get_formula_bdd(Root, Formula, BDD) } ->
{ del_bdd(Root) },
( { clpb_residuals(bdd) } ->
{ bdd_nodes(BDD, Nodes),
phrase(nodes(Nodes), Ns) },
[clpb:'$clpb_bdd'(Ns)]
; { prepare_global_variables(BDD),
phrase(sat_ands(Formula), Ands0),
; { phrase(sat_ands(Formula), Ands0),
ands_fusion(Ands0, Ands),
maplist(formula_anf, Ands, ANFs0),
sort(ANFs0, ANFs1),
@@ -1400,39 +1717,24 @@ attribute_goals(Var) -->
booleans(RestVs)
; boolean(Var) % the variable may have occurred only in taut/2
).
attribute_goals(Var) -->
{ get_atts(Var, clpb_max(_)),
!,
put_atts(Var, -clpb_max(_)) }.
attribute_goals(Var) -->
{ get_atts(Var, clpb_bdd(BDD)),
ground(BDD),
put_atts(Var, -clpb_bdd(_)) }.
del_clpb(Var) :-
del_attr(Var, clpb),
del_attr(Var, clpb_hash).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
To make residual projection work with recorded constraints, the
global counters must be adjusted so that new variables and nodes
also get new IDs. Also, clpb_next_id/2 is used to actually create
these counters, because creating them with b_setval/2 would make
them [] on backtracking, which is quite unfortunate in itself.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
del_attr(Var, clpb_hash),
del_attr(Var, clpb_atom).
b_setval(K, T) :- bb_b_put(K, T).
nb_setval(K, T) :- bb_put(K, T).
b_getval(K, T) :- bb_get(K, T).
prepare_global_variables(BDD) :-
clpb_next_id('$clpb_next_var', V0),
clpb_next_id('$clpb_next_node', N0),
bdd_nodes(BDD, Nodes),
foldl(max_variable_node, Nodes, V0-N0, MaxV0-MaxN0),
MaxV is MaxV0 + 1,
MaxN is MaxN0 + 1,
b_setval('$clpb_next_var', MaxV),
b_setval('$clpb_next_node', MaxN).
max_variable_node(Node, V0-N0, V-N) :-
node_id(Node, N1),
node_varindex(Node, V1),
N is max(N0,N1),
V is max(V0,V1).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Fuse formulas that share the same variables into single conjunctions.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
@@ -1557,7 +1859,8 @@ booleans([B|Bs]) --> boolean(B), booleans(Bs).
boolean(Var) -->
{ del_clpb(Var) },
( { get_attr(Var, clpb_omit_boolean, true) } -> []
( { get_attr(Var, clpb_omit_boolean, true) } ->
{ put_atts(Var, -clpb_omit_boolean(_)) }
; [clpb:sat(Var =:= Var)]
).
@@ -1659,49 +1962,3 @@ clpb_atom_var(Atom, Var) :-
put_assoc(Atom, A0, Var, A),
b_setval('$clpb_atoms', A)
).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Compatibility predicates.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
include(Goal, List, Is) :-
include_(List, Goal, Is).
include_([], _, []).
include_([X1|Xs1], P, Is) :-
( call(P, X1)
-> Is = [X1|Is1]
; Is = Is1
),
include_(Xs1, P, Is1).
exclude(Goal, List, Is) :-
exclude_(List, Goal, Is).
exclude_([], _, []).
exclude_([X1|Xs1], P, Is) :-
( call(P, X1)
-> Is = Is1
; Is = [X1|Is1]
),
exclude_(Xs1, P, Is1).
partition(Pred, List, Less, Equal, Greater) :-
partition_(List, Pred, Less, Equal, Greater).
partition_([], _, [], [], []).
partition_([H|T], Pred, L, E, G) :-
call(Pred, H, Diff),
partition_(Diff, H, Pred, T, L, E, G).
partition_(<, H, Pred, T, [H|Rest], E, G) :-
partition_(T, Pred, Rest, E, G).
partition_(=, H, Pred, T, L, [H|Rest], G) :-
partition_(T, Pred, L, Rest, G).
partition_(>, H, Pred, T, L, E, [H|Rest]) :-
partition_(T, Pred, L, E, Rest).

File diff suppressed because it is too large Load Diff

View File

@@ -1,20 +1,20 @@
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Written 2020, 2021, 2022 by Markus Triska (triska@metalevel.at)
Written 2020-2023 by Markus Triska (triska@metalevel.at)
Part of Scryer Prolog.
Predicates for cryptographic applications.
/** Predicates for cryptographic applications.
This library assumes that the Prolog flag double_quotes is set to chars.
This library assumes that the Prolog flag `double_quotes` is set to `chars`.
In Scryer Prolog, lists of characters are very efficiently represented,
and strings have the advantage that the atom table remains unmodified.
Especially for cryptographic applications, it is an advantage that
using strings leaves little trace of what was processed in the system.
For predicates that accept an encoding/1 option to specify the encoding
of the input data, if encoding(octet) is used, then the input can also
be specified as a list of bytes, i.e., integers between 0 and 255.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
For predicates that accept an `encoding/1` option to specify the encoding
of the input data, if `encoding(octet)` is used, then the input can also
be specified as a list of _bytes_, i.e., integers between 0 and 255.
*/
:- module(crypto,
[hex_bytes/2, % ?Hex, ?Bytes
@@ -48,20 +48,20 @@
:- use_module(library(si)).
:- use_module(library(iso_ext), [partial_string/3]).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
hex_bytes(?Hex, ?Bytes) is det.
Relation between a hexadecimal sequence and a list of bytes. Hex
is a string of hexadecimal numbers. Bytes is a list of *integers*
between 0 and 255 that represent the sequence as a list of bytes.
At least one of the arguments must be instantiated.
Example:
?- hex_bytes("501ACE", Bs).
Bs = [80,26,206].
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
%% hex_bytes(?Hex, ?Bytes) is det.
%
% Relation between a hexadecimal sequence and a list of bytes. Hex
% is a string of hexadecimal numbers. Bytes is a list of _integers_
% between 0 and 255 that represent the sequence as a list of bytes.
% At least one of the arguments must be instantiated.
%
% Example:
%
% ```
% ?- hex_bytes("501ACE", Bs).
% Bs = [80,26,206].
% ```
hex_bytes(Hs, Bytes) :-
( ground(Hs) ->
@@ -113,47 +113,52 @@ must_be_octet_chars(Chars, Context) :-
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Cryptographically secure random numbers
=======================================
crypto_n_random_bytes(+N, -Bytes) is det
Bytes is unified with a list of N cryptographically secure
pseudo-random bytes. Each byte is an integer between 0 and 255. If
the internal pseudo-random number generator (PRNG) has not been
seeded with enough entropy to ensure an unpredictable byte
sequence, an exception is thrown.
One way to relate such a list of bytes to an _integer_ is to use
CLP() constraints as follows:
:- use_module(library(clpz)).
:- use_module(library(lists)).
bytes_integer(Bs, N) :-
foldl(pow, Bs, 0-0, N-_).
pow(B, N0-I0, N-I) :-
B in 0..255,
N #= N0 + B*256^I0,
I #= I0 + 1.
With this definition, we can generate a random 256-bit integer
_from_ a list of 32 random _bytes_:
?- crypto_n_random_bytes(32, Bs),
bytes_integer(Bs, I).
Bs = [146,166,162,210,242,7,25,132,64,94|...],
I = 337420085690608915485...(56 digits omitted).
The above relation also works in the other direction, letting you
translate an integer _to_ a list of bytes. In addition, you can
use hex_bytes/2 to convert bytes to _tokens_ that can be easily
exchanged in your applications.
?- crypto_n_random_bytes(12, Bs),
hex_bytes(Hex, Bs).
Bs = [34,25,50,72,58,63,50,172,32,46|...], Hex = "221932483a3f32ac202 ...".
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
%% crypto_n_random_bytes(+N, -Bytes) is det.
%
% Bytes is unified with a list of N cryptographically secure
% pseudo-random bytes. Each byte is an integer between 0 and 255. If
% the internal pseudo-random number generator (PRNG) has not been
% seeded with enough entropy to ensure an unpredictable byte
% sequence, an exception is thrown.
%
% One way to relate such a list of bytes to an _integer_ is to use
% CLP() constraints as follows:
%
% ```
% :- use_module(library(clpz)).
% :- use_module(library(lists)).
%
% bytes_integer(Bs, N) :-
% foldl(pow, Bs, 0-0, N-_).
%
% pow(B, N0-I0, N-I) :-
% B in 0..255,
% N #= N0 + B*256^I0,
% I #= I0 + 1.
% ```
%
% With this definition, we can generate a random 256-bit integer
% _from_ a list of 32 random _bytes_:
%
% ```
% ?- crypto_n_random_bytes(32, Bs),
% bytes_integer(Bs, I).
% Bs = [146,166,162,210,242,7,25,132,64,94|...],
% I = 337420085690608915485...(56 digits omitted).
% ```
%
% The above relation also works in the other direction, letting you
% translate an integer _to_ a list of bytes. In addition, you can
% use `hex_bytes/2` to convert bytes to _tokens_ that can be easily
% exchanged in your applications.
%
% ```
% ?- crypto_n_random_bytes(12, Bs),
% hex_bytes(Hex, Bs).
% Bs = [34,25,50,72,58,63,50,172,32,46|...], Hex = "221932483a3f32ac202 ...".
% ```
crypto_n_random_bytes(N, Bs) :-
must_be(integer, N),
@@ -165,30 +170,34 @@ crypto_random_byte(B) :- '$crypto_random_byte'(B).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Hashing
=======
crypto_data_hash(+Data, -Hash, +Options)
Where Data is a list of characters, and Hash is the computed hash
as a list of hexadecimal characters.
Options is a list of:
- algorithm(+A)
where A is one of ripemd160, sha256, sha384, sha512, sha512_256,
sha3_224, sha3_256, sha3_384, sha3_512, blake2s256, blake2b512,
or a variable. If A is a variable, then it is unified with the
default algorithm, which is an algorithm that is considered
cryptographically secure at the time of this writing.
- encoding(+Encoding)
The default encoding is utf8. The alternative is octet,
to treat the input as a list of raw bytes.
Example:
?- crypto_data_hash("abc", Hs, [algorithm(sha256)]).
Hs = "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad".
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
%% crypto_data_hash(+Data, -Hash, +Options)
%
% Where Data is a list of characters, and Hash is the computed hash
% as a list of hexadecimal characters.
%
% Options is a list of:
%
% - `algorithm(+A)`
% where `A` is one of `ripemd160`, `sha256`, `sha384`, `sha512`,
% `sha512_256`, `sha3_224`, `sha3_256`, `sha3_384`,
% `sha3_512`, `blake2s256`, `blake2b512`, or a variable. If `A` is
% a variable, then it is unified with the default algorithm,
% which is an algorithm that is considered cryptographically
% secure at the time of this writing.
%
% - `encoding(+Encoding)`
% The default encoding is `utf8`. The alternative is `octet`, to
% treat the input as a list of raw bytes.
%
% Example:
%
% ```
% ?- crypto_data_hash("abc", Hs, [algorithm(sha256)]).
% Hs = "ba7816bf8f01cfea414140de5dae2223b00361a396177a9cb410ff61f20015ad".
% ```
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
SHA256 is the current default for several hash-related predicates.
It is deemed sufficiently secure for the foreseeable future. Yet,
@@ -238,38 +247,36 @@ hash_algorithm(blake2s256).
hash_algorithm(blake2b512).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
crypto_data_hkdf(+Data, +Length, -Bytes, +Options) is det.
Concentrate possibly dispersed entropy of Data and then expand it
to the desired length. Data is a list of characters.
Bytes is unified with a list of bytes of length Length, and is
suitable as input keying material and initialization vectors to
symmetric encryption algorithms.
Admissible options are:
- algorithm(+Algorithm)
One of sha256, sha384 or sha512. If you specify a variable,
then it is unified with the algorithm that was used, which is a
cryptographically secure algorithm by default.
- info(+Info)
Optional context and application specific information,
specified as a list of characters. The default is [].
- salt(+List)
Optionally, a list of bytes that are used as salt. The
default is all zeroes.
- encoding(+Encoding)
The default encoding is utf8. The alternative is octet,
to treat the input as a list of raw bytes.
The `info/1` option can be used to generate multiple keys from a
single master key, using for example values such as "key" and
"iv", or the name of a file that is to be encrypted.
See crypto_n_random_bytes/2 to obtain a suitable salt.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
%% crypto_data_hkdf(+Data, +Length, -Bytes, +Options) is det.
%
% Concentrate possibly dispersed entropy of Data and then expand it
% to the desired length. Data is a list of characters.
%
% Bytes is unified with a list of bytes of length Length, and is
% suitable as input keying material and initialization vectors to
% symmetric encryption algorithms.
%
% Admissible options are:
%
% - `algorithm(+Algorithm)`
% One of `sha256`, `sha384` or `sha512`. If you specify a variable,
% then it is unified with the algorithm that was used, which is a
% cryptographically secure algorithm by default.
% - `info(+Info)`
% Optional context and application specific information,
% specified as a list of characters. The default is `[]`.
% - `salt(+List)`
% Optionally, a list of bytes that are used as salt. The
% default is all zeroes.
% - `encoding(+Encoding)`
% The default encoding is `utf8`. The alternative is `octet`,
% to treat the input as a list of raw bytes.
%
% The `info/1` option can be used to generate multiple keys from a
% single master key, using for example values such as "key" and
% "iv", or the name of a file that is to be encrypted.
%
% See `crypto_n_random_bytes/2` to obtain a suitable salt.
crypto_data_hkdf(Data0, L, Bytes, Options0) :-
functor_hash_options(algorithm, Algorithm, Options0, Options),
@@ -323,14 +330,12 @@ chars_bytes_(Cs, Bytes, Context) :-
know if you need to rely on any specifics of this format.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
crypto_password_hash(+Password, ?Hash) is semidet.
If Hash is instantiated, the predicate succeeds _iff_ the hash
matches the given password. Otherwise, the call is equivalent to
crypto_password_hash(Password, Hash, []) and computes a
password-based hash using the default options.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
%% crypto_password_hash(+Password, ?Hash) is semidet.
%
% If Hash is instantiated, the predicate succeeds _iff_ the hash
% matches the given password. Otherwise, the call is equivalent to
% `crypto_password_hash(Password, Hash, [])` and computes a
% password-based hash using the default options.
crypto_password_hash(Password0, Hash) :-
( nonvar(Hash) ->
@@ -353,58 +358,56 @@ dollar_segments(Ls, Segments) :-
).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
crypto_password_hash(+Password, -Hash, +Options) is det.
Derive Hash based on Password. This predicate is similar to
crypto_data_hash/3 in that it derives a hash from given data.
However, it is tailored for the specific use case of _passwords_.
One essential distinction is that for this use case, the derivation
of a hash should be _as slow as possible_ to counteract brute-force
attacks over possible passwords.
Another important distinction is that equal passwords must yield,
with very high probability, _different_ hashes. For this reason,
cryptographically strong random numbers are automatically added to
the password before a hash is derived.
Hash is unified with a string that contains the computed hash and
all parameters that were used, except for the password. Instead of
storing passwords, store these hashes. Later, you can verify the
validity of a password with crypto_password_hash/2, comparing the
then entered password to the stored hash. If you need to export this
atom, you should treat it as opaque ASCII data with up to 255 bytes
of length. The maximal length may increase in the future.
Admissible options are:
- algorithm(+Algorithm)
The algorithm to use. Currently, the only available algorithm
is 'pbkdf2-sha512', which is therefore also the default.
- cost(+C)
C is an integer, denoting the binary logarithm of the number
of _iterations_ used for the derivation of the hash. This
means that the number of iterations is set to 2^C. Currently,
the default is 17, and thus more than one hundred _thousand_
iterations. You should set this option as high as your server
and users can tolerate. The default is subject to change and
will likely increase in the future or adapt to new algorithms.
- salt(+Salt)
Use the given list of bytes as salt. By default,
cryptographically secure random numbers are generated for this
purpose. The default is intended to be secure, and constitutes
the typical use case of this predicate.
Currently, PBKDF2 with SHA-512 is used as the hash derivation
function, using 128 bits of salt. All default parameters, including
the algorithm, are subject to change, and other algorithms will also
become available in the future. Since computed hashes store all
parameters that were used during their derivation, such changes will
not affect the operation of existing deployments. Note though that
new hashes will then be computed with the new default parameters.
See crypto_data_hkdf/4 for generating keys from Hash.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
%% crypto_password_hash(+Password, -Hash, +Options) is det.
%
% Derive Hash based on Password. This predicate is similar to
% `crypto_data_hash/3` in that it derives a hash from given data.
% However, it is tailored for the specific use case of _passwords_.
% One essential distinction is that for this use case, the derivation
% of a hash should be _as slow as possible_ to counteract brute-force
% attacks over possible passwords.
%
% Another important distinction is that equal passwords must yield,
% with very high probability, _different_ hashes. For this reason,
% cryptographically strong random numbers are automatically added to
% the password before a hash is derived.
%
% Hash is unified with a string that contains the computed hash and
% all parameters that were used, except for the password. Instead of
% storing passwords, store these hashes. Later, you can verify the
% validity of a password with `crypto_password_hash/2`, comparing the
% then entered password to the stored hash. If you need to export this
% atom, you should treat it as opaque ASCII data with up to 255 bytes
% of length. The maximal length may increase in the future.
%
% Admissible options are:
%
% - `algorithm(+Algorithm)`
% The algorithm to use. Currently, the only available algorithm
% is `'pbkdf2-sha512'`, which is therefore also the default.
% - `cost(+C)`
% C is an integer, denoting the binary logarithm of the number
% of _iterations_ used for the derivation of the hash. This
% means that the number of iterations is set to 2^C. Currently,
% the default is 17, and thus more than one hundred _thousand_
% iterations. You should set this option as high as your server
% and users can tolerate. The default is subject to change and
% will likely increase in the future or adapt to new algorithms.
% - `salt(+Salt)`
% Use the given list of bytes as salt. By default,
% cryptographically secure random numbers are generated for this
% purpose. The default is intended to be secure, and constitutes
% the typical use case of this predicate.
%
% Currently, PBKDF2 with SHA-512 is used as the hash derivation
% function, using 128 bits of salt. All default parameters, including
% the algorithm, are subject to change, and other algorithms will also
% become available in the future. Since computed hashes store all
% parameters that were used during their derivation, such changes will
% not affect the operation of existing deployments. Note though that
% new hashes will then be computed with the new default parameters.
%
% See `crypto_data_hkdf/4` for generating keys from Hash.
crypto_password_hash(Password0, Hash, Options) :-
chars_bytes_(Password0, Password, crypto_password_hash/3),
@@ -435,97 +438,94 @@ bytes_base64(Bytes, Base64) :-
chars_base64(Chars, Base64, [padding(false)])
).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
crypto_data_encrypt(+PlainText,
+Algorithm,
+Key,
+IV,
-CipherText,
+Options).
Encrypt the given PlainText, using the symmetric algorithm
Algorithm, key Key, and initialization vector (or nonce) IV, to
give CipherText.
PlainText must be a list of characters, Key and IV must be lists of
bytes, and CipherText is created as a list of characters.
Keys and IVs can be chosen at random (using for example
crypto_n_random_bytes/2) or derived from input keying material (IKM)
using for example crypto_data_hkdf/4. This input is often a shared
secret, such as a negotiated point on an elliptic curve, or the hash
that was computed from a password via crypto_password_hash/3 with a
freshly generated and specified _salt_.
Reusing the same combination of Key and IV typically leaks at least
_some_ information about the plaintext. For example, identical
plaintexts will then correspond to identical ciphertexts. For some
algorithms, reusing an IV with the same Key has disastrous results
and can cause the loss of all properties that are otherwise
guaranteed. Especially in such cases, an IV is also called a
_nonce_ (number used once).
It is safe to store and transfer the used initialization vector (or
nonce) in plain text, but the key _must be kept secret_.
Currently, the only supported algorithm is 'chacha20-poly1305', a
powerful and efficient _authenticated_ encryption scheme, providing
secrecy and at the same time reliable protection against undetected
_modifications_ of the encrypted data. This is a very good choice
for virtually all use cases. It is a stream cipher and can encrypt
data of any length up to 256 GB. Further, the encrypted data has
exactly the same length as the original, and no padding is used.
Options:
- encoding(+Encoding)
Encoding to use for PlainText. Default is utf8. The alternative
is octet to treat PlainText as raw bytes.
- tag(-List)
For authenticated encryption schemes, List is unified with a
list of _bytes_ holding the tag. This tag must be provided for
decryption.
- aad(+Data)
Data is additional authenticated data (AAD), a list of
characters. It is authenticated in that it influences the tag,
but it is not encrypted. The encoding/1 option also specifies
the encoding of Data.
Here is an example encryption and decryption, using the ChaCha20
stream cipher with the Poly1305 authenticator. This cipher uses a
256-bit key and a 96-bit nonce, i.e., 32 and 12 _bytes_,
respectively:
?- Algorithm = 'chacha20-poly1305',
crypto_n_random_bytes(32, Key),
crypto_n_random_bytes(12, IV),
crypto_data_encrypt("this text is to be encrypted", Algorithm,
Key, IV, CipherText, [tag(Tag)]),
crypto_data_decrypt(CipherText, Algorithm,
Key, IV, RecoveredText, [tag(Tag)]).
Yielding:
Algorithm = 'chacha20-poly1305',
Key = [113,247,153,134,177,220,13,193,50,150|...],
IV = [135,20,149,153,63,35,68,114,247,171|...],
CipherText = "\x94\0Ej\x94\®Â\x95\óÑÆXÃn¾ð©b\x1c\ ...",
RecoveredText = "this text is to be ...",
Tag = [152,117,152,17,162,75,150,206,144,40|...]
In this example, we use crypto_n_random_bytes/2 to generate a key
and nonce from cryptographically secure random numbers. For
repeated applications, you must ensure that a nonce is only used
_once_ together with the same key. Note that for _authenticated_
encryption schemes, the _tag_ that was computed during encryption
is necessary for decryption. It is safe to store and transfer the
tag in plain text.
See also crypto_data_decrypt/6, and hex_bytes/2 for conversion
between bytes and hex encoding.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
%% crypto_data_encrypt(+PlainText, +Algorithm, +Key, +IV, -CipherText, +Options).
%
% Encrypt the given PlainText, using the symmetric algorithm
% Algorithm, key Key, and initialization vector (or nonce) IV, to
% give CipherText.
%
% PlainText must be a list of characters, Key and IV must be lists of
% bytes, and CipherText is created as a list of characters.
%
% Keys and IVs can be chosen at random (using for example
% `crypto_n_random_bytes/2`) or derived from input keying material (IKM)
% using for example `crypto_data_hkdf/4`. This input is often a shared
% secret, such as a negotiated point on an elliptic curve, or the hash
% that was computed from a password via `crypto_password_hash/3` with a
% freshly generated and specified _salt_.
%
% Reusing the same combination of Key and IV typically leaks at least
% _some_ information about the plaintext. For example, identical
% plaintexts will then correspond to identical ciphertexts. For some
% algorithms, reusing an IV with the same Key has disastrous results
% and can cause the loss of all properties that are otherwise
% guaranteed. Especially in such cases, an IV is also called a
% _nonce_ (number used once).
%
% It is safe to store and transfer the used initialization vector (or
% nonce) in plain text, but the key _must be kept secret_.
%
% Currently, the only supported algorithm is 'chacha20-poly1305', a
% powerful and efficient _authenticated_ encryption scheme, providing
% secrecy and at the same time reliable protection against undetected
% _modifications_ of the encrypted data. This is a very good choice
% for virtually all use cases. It is a stream cipher and can encrypt
% data of any length up to 256 GB. Further, the encrypted data has
% exactly the same length as the original, and no padding is used.
%
% Options:
%
% - `encoding(+Encoding)`
% Encoding to use for PlainText. Default is utf8. The alternative
% is octet to treat PlainText as raw bytes.
%
% - `tag(-List)`
% For authenticated encryption schemes, List is unified with a
% list of _bytes_ holding the tag. This tag must be provided for
% decryption.
%
% - `aad(+Data)`
% Data is additional authenticated data (AAD), a list of
% characters. It is authenticated in that it influences the tag,
% but it is not encrypted. The `encoding/1` option also specifies
% the encoding of Data.
%
% Here is an example encryption and decryption, using the ChaCha20
% stream cipher with the Poly1305 authenticator. This cipher uses a
% 256-bit key and a 96-bit nonce, i.e., 32 and 12 _bytes_,
% respectively:
%
% ```
% ?- Algorithm = 'chacha20-poly1305',
% crypto_n_random_bytes(32, Key),
% crypto_n_random_bytes(12, IV),
% crypto_data_encrypt("this text is to be encrypted", Algorithm,
% Key, IV, CipherText, [tag(Tag)]),
% crypto_data_decrypt(CipherText, Algorithm,
% Key, IV, RecoveredText, [tag(Tag)]).
% ```
%
% Yielding:
%
% ```
% Algorithm = 'chacha20-poly1305',
% Key = [113,247,153,134,177,220,13,193,50,150|...],
% IV = [135,20,149,153,63,35,68,114,247,171|...],
% CipherText = "\x94\0Ej\x94\®Â\x95\óÑÆXÃn¾ð©b\x1c\ ...",
% RecoveredText = "this text is to be ...",
% Tag = [152,117,152,17,162,75,150,206,144,40|...]
% ```
%
% In this example, we use `crypto_n_random_bytes/2` to generate a key
% and nonce from cryptographically secure random numbers. For
% repeated applications, you must ensure that a nonce is only used
% _once_ together with the same key. Note that for _authenticated_
% encryption schemes, the _tag_ that was computed during encryption
% is necessary for decryption. It is safe to store and transfer the
% tag in plain text.
%
% See also `crypto_data_decrypt/6`, and `hex_bytes/2` for conversion
% between bytes and hex encoding.
crypto_data_encrypt(PlainText0, Algorithm, Key, IV, CipherText, Options) :-
options_data_chars(Options, PlainText0, PlainText, Encoding),
@@ -549,37 +549,30 @@ algorithm_key_iv('chacha20-poly1305', Key, IV) :-
length(Key, 32),
length(IV, 12).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
crypto_data_decrypt(+CipherText,
+Algorithm,
+Key,
+IV,
-PlainText,
+Options).
Decrypt the given CipherText, using the symmetric algorithm
Algorithm, key Key, and initialization vector IV, to give
PlainText. CipherText must be a list of characters, and Key and IV
must be lists of bytes. PlainText is created as a list of
characters.
Currently, the only supported algorithm is 'chacha20-poly1305',
a very secure, fast and versatile authenticated encryption method.
Options is a list of:
- encoding(+Encoding)
Encoding to use for PlainText. The default is utf8. The
alternative is octet, which is used if the data are raw bytes.
- tag(+Tag)
For authenticated encryption schemes, the tag must be specified as
a list of bytes exactly as they were generated upon encryption.
- aad(+Data)
Any additional authenticated data (AAD) must be specified. The
encoding/1 option also specifies the encoding of Data.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
%% crypto_data_decrypt(+CipherText, +Algorithm, +Key, +IV, -PlainText, +Options).
%
% Decrypt the given CipherText, using the symmetric algorithm
% Algorithm, key Key, and initialization vector IV, to give
% PlainText. CipherText must be a list of characters, and Key and IV
% must be lists of bytes. PlainText is created as a list of
% characters.
%
% Currently, the only supported algorithm is 'chacha20-poly1305',
% a very secure, fast and versatile authenticated encryption method.
%
% Options is a list of:
%
% - `encoding(+Encoding)`
% Encoding to use for PlainText. The default is utf8. The
% alternative is octet, which is used if the data are raw bytes.
%
% - `tag(+Tag)`
% For authenticated encryption schemes, the tag must be specified as
% a list of bytes exactly as they were generated upon encryption.
%
% - `aad(+Data)`
% Any additional authenticated data (AAD) must be specified. The
% `encoding/1` option also specifies the encoding of Data.
crypto_data_decrypt(CipherText0, Algorithm, Key, IV, PlainText, Options) :-
option(tag(Tag), Options, []),
@@ -617,49 +610,53 @@ encoding_chars(utf8, Cs, Cs) :-
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Digital signatures with Ed25519
===============================
- ed25519_new_keypair(-Pair)
Yields a new Ed25519 key pair Pair, a list of characters. The
pair contains the private key and must be kept absolutely secret.
Pair can be used for signing. Its public key can be obtained
with ed25519_keypair_public_key/2.
- ed25519_keypair_public_key(+Pair, -PublicKey)
PublicKey is the public key of the given key pair. The public key
can be used for signature verification, and can be shared freely.
The public key is represented as a list of characters.
- ed25519_sign(+Key, +Data, -Signature, +Options)
Key and Data must be lists of characters. Key is a key pair in
PKCS#8 v2 format as generated by ed25519_new_keypair/1. Sign Data
with Key, yielding Signature as a list of hexadecimal characters.
- ed25519_verify(+Key, +Data, +Signature, +Options)
Key and Data must be lists of characters. Key is a public key.
Succeeds if Data was signed with the private key corresponding to
Key, where Signature is a list of hexadecimal characters as
generated by ed25519_sign/4. Fails otherwise.
Currently, the only option for signing and verifying is:
- encoding(+Encoding)
The default encoding of Data is utf8. The alternative is octet,
which treats Data as a list of raw bytes.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
%% ed25519_new_keypair(-Pair)
%
% Yields a new Ed25519 key pair Pair, a list of characters. The
% pair contains the private key and must be kept absolutely secret.
% Pair can be used for signing. Its public key can be obtained
% with `ed25519_keypair_public_key/2`.
ed25519_new_keypair(Pair) :-
'$ed25519_new_keypair'(Pair).
%% ed25519_keypair_public_key(+Pair, -PublicKey)
%
% PublicKey is the public key of the given key pair. The public key
% can be used for signature verification, and can be shared freely.
% The public key is represented as a list of characters.
ed25519_keypair_public_key(Pair, PublicKey) :-
must_be_octet_chars(Pair, ed25519_keypair_public_key),
'$ed25519_keypair_public_key'(Pair, PublicKey).
%% ed25519_sign(+Key, +Data, -Signature, +Options)
%
% Key and Data must be lists of characters. Key is a key pair in
% PKCS#8 v2 format as generated by `ed25519_new_keypair/1`. Sign Data
% with Key, yielding Signature as a list of hexadecimal characters.
ed25519_sign(Key, Data0, Signature, Options) :-
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, +Data, +Signature, +Options)
%
% Key and Data must be lists of characters. Key is a public key.
% Succeeds if Data was signed with the private key corresponding to
% Key, where Signature is a list of hexadecimal characters as
% generated by `ed25519_sign/4`. Fails otherwise.
%
% Currently, the only option for signing and verifying is:
%
% - `encoding(+Encoding)`
% The default encoding of Data is `utf8`. The alternative is `octet`,
% which treats Data as a list of raw bytes.
ed25519_verify(Key, Data0, Signature0, Options) :-
must_be_octet_chars(Key, ed25519_verify),
options_data_chars(Options, Data0, Data, Encoding),
@@ -669,38 +666,43 @@ ed25519_verify(Key, Data0, Signature0, Options) :-
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
X25519: ECDH key exchange over Curve25519
=========================================
Points on Curve25519 are represented as lists of characters that denote
the u-coordinate of the Montgomery curve.
- curve25519_generator(-Gs)
Gs is the generator point of Curve25519.
- curve25519_scalar_mult(+Scalar, +Ps, -Rs)
Scalar must be an integer between 0 and 2^256-1,
or a list of 32 bytes, and Ps must be a point on the curve.
Computes the point Rs = Scalar*Ps as mandated by X25519.
Alice and Bob can use this to establish a shared secret as follows,
where Gs is the generator point of Curve25519:
1. Alice creates a random integer a and sends As = a*Gs to Bob.
2. Bob creates a random integer b and sends Bs = b*Gs to Alice.
3. Alice computes Rs = a*Bs.
4. Bob computes Rs = b*As.
5. Alice and Bob use crypto_data_hkdf/4 on Rs with suitable
(same) parameters to obtain lists of bytes that can be used as
keys and initialization vectors for symmetric encryption.
If a and b are kept secret, this method is considered very secure.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
%% curve25519_generator(-Gs)
%
% Points on Curve25519 are represented as lists of characters that
% denote the u-coordinate of the Montgomery curve. Gs is the
% generator point of Curve25519.
curve25519_generator(Gs) :-
length(Gs0, 32),
Gs0 = [9|Zs],
maplist(=(0), Zs),
maplist(char_code, Gs, Gs0).
%% curve25519_scalar_mult(+Scalar, +Ps, -Rs)
%
% Scalar must be an integer between 0 and 2^256-1,
% or a list of 32 bytes, and Ps must be a point on the curve.
% Computes the point _Rs = Scalar*Ps as_ mandated by X25519.
%
% Alice and Bob can use this to establish a shared secret as follows,
% where Gs is the generator point of Curve25519:
%
% 1. Alice creates a random integer _a_ and sends _As = a*Gs_ to Bob.
%
% 2. Bob creates a random integer _b_ and sends _Bs = b*Gs_ to Alice.
%
% 3. Alice computes _Rs = a*Bs_.
%
% 4. Bob computes _Rs = b*As_.
%
% 5. Alice and Bob use `crypto_data_hkdf/4` on Rs with suitable
% (same) parameters to obtain lists of bytes that can be used as
% keys and initialization vectors for symmetric encryption.
%
% If _a_ and _b_ are kept secret, this method is considered very secure.
curve25519_scalar_mult(Scalar, Point, Result) :-
( integer_si(Scalar) ->
length(ScalarBytes, 32),
@@ -709,6 +711,8 @@ curve25519_scalar_mult(Scalar, Point, Result) :-
must_be_bytes(ScalarBytes, curve25519_scalar_mult/3),
length(ScalarBytes, 32)
),
must_be(chars, Point),
length(Point, 32),
maplist(char_code, Point, PointBytes),
'$curve25519_scalar_mult'(ScalarBytes, PointBytes, Result).

View File

@@ -1,54 +1,67 @@
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Predicates for parsing CSV data
/** Predicates for parsing CSV data
## Read CSV files.
Read csv files
Only two options with default values:
Only two options with default values :
- token_separator(',')
- with_header(true)
- `token_separator(',')`
- `with_header(true)`
Examples
### Examples:
* parsing a csv string:
Parsing a CSV string:
?- use_module(library(csv)).
?- use_module(library(dcgs)).
?- phrase(parse_csv(Data), "col1,col2,col3,col4\none,2,,three").
Data = frame(["col1","col2","col3","col4"],[["one",2,[],"three"]]).
```
?- use_module(library(csv)).
?- use_module(library(dcgs)).
?- phrase(parse_csv(Data), "col1,col2,col3,col4\none,2,,three").
Data = frame(["col1","col2","col3","col4"],[["one",2,[],"three"]]).
```
* with some options:
With some options:
?- phrase(parse_csv(Data, [with_header(false), token_separator(';')]), "one;2;;three").
Data = frame([],[["one",2,[],"three"]]).
```
?- phrase(parse_csv(Data, [with_header(false), token_separator(';')]), "one;2;;three").
Data = frame([],[["one",2,[],"three"]]).
```
* parsing a csv file:
Parsing a CSV file:
?- use_module(library(csv)).
?- use_module(library(pio)).
?- phrase_from_file(parse_csv(frame(Header, Rows)), './test.csv').
```
?- use_module(library(csv)).
?- use_module(library(pio)).
?- phrase_from_file(parse_csv(frame(Header, Rows)), './test.csv').
```
## Write CSV files
Write csv files
Four options with default values :
Four options with default values :
- line_separator('\n')
- token_separator(',')
- with_header(true)
- null_value(empty)
- `line_separator('\n')`
- `token_separator(',')`
- `with_header(true)`
- `null_value(empty)`
Examples
### Examples
* writing a csv file:
Writing a CSV file:
?- use_module(library(csv)).
?- write_csv('./test.csv', frame(["col1","col2","col3","col4"], [["one",2,[],"three"]])).
```
?- use_module(library(csv)).
?- write_csv('./test.csv', frame(["col1","col2","col3","col4"], [["one",2,[],"three"]])).
```
* with some options
With some options
?- use_module(library(csv)).
?- write_csv('./test.csv', frame(["col1","col2","col3","col4"], [["one",2,[],"three"]]), [with_header(false), line_separator('\r\n'), token_separator(';'), null_value('\\N')]).
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
```
?- use_module(library(csv)).
?- write_csv('./test.csv', frame(
["col1","col2","col3","col4"],
[["one",2,[],"three"]]
),
[with_header(false), line_separator('\r\n'), token_separator(';'), null_value('\\N')]).
```
*/
:- module(csv, [
parse_csv//1,

View File

@@ -1,3 +1,13 @@
/** Support for Definite Clause Grammars.
A Prolog definite clause grammar (DCG) describes a sequence. Operationally, DCGs
can be used to parse, generate, complete and check sequences manifested as lists.
Check [The Power of Prolog chapter on DCGs](https://www.metalevel.at/prolog/dcg)
to learn more about them.
*/
:- module(dcgs,
[op(1105, xfy, '|'),
phrase/2,
@@ -16,9 +26,44 @@
:- meta_predicate phrase(2, ?, ?).
%% phrase(+Body, ?Ls).
%
% True iff Body describes the list Ls. Body must be a DCG body.
% It is equivalent to `phrase(Body, Ls, [])`.
%
% Examples:
%
% ```
% as --> [].
% as --> [a], as.
%
% ?- phrase(as, Ls).
% Ls = []
% ; Ls = "a"
% ; Ls = "aa"
% ; Ls = "aaa"
% ; ... .
%
% ?- phrase(as, "aaa").
% true.
% ```
phrase(GRBody, S0) :-
phrase(GRBody, S0, []).
%% phrase(+Body, ?Ls, ?Ls0).
%
% True iff Body describes part of the list Ls and the rest of Ls is Ls0.
%
% Example:
%
% ```
% ?- phrase(seq(X), "aaa", Y).
% X = [], Y = "aaa"
% ; X = "a", Y = "aa"
% ; X = "aa", Y = "a"
% ; X = "aaa", Y = [].
% ```
phrase(GRBody, S0, S) :-
strip_module(GRBody, M, GRBody1),
( var(GRBody) ->
@@ -30,13 +75,6 @@ phrase(GRBody, S0, S) :-
; call(M:GRBody1, S0, S)
).
module_call_qualified(M, Call, Call1) :-
( nonvar(M) -> Call1 = M:Call
; 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),
@@ -82,7 +120,10 @@ dcg_body(NonTerminal, S0, S, Goal1) :-
NonTerminal \= ( \+ _ ),
loader:strip_module(NonTerminal, M, NonTerminal0),
dcg_non_terminal(NonTerminal0, S0, S, Goal0),
module_call_qualified(M, Goal0, Goal1).
( functor(NonTerminal, (:), 2) ->
Goal1 = M:Goal0
; Goal1 = Goal0
).
% The following constructs in a grammar rule body
% are defined in the corresponding subclauses.
@@ -131,6 +172,9 @@ user:term_expansion(Term0, Term) :-
nonvar(Term0),
dcg_rule(Term0, Term).
%% seq(Seq)//
%
% Describes a sequence
seq(Xs, Cs0,Cs) :-
var(Xs),
@@ -141,10 +185,14 @@ seq(Xs, Cs0,Cs) :-
seq([]) --> [].
seq([E|Es]) --> [E], seq(Es).
%% seqq(SeqOfSeqs)//
%
% Describes a sequence of sequences
seqq([]) --> [].
seqq([Es|Ess]) --> seq(Es), seqq(Ess).
%% ...//
%
% Describes an arbitrary number of elements
...(Cs0,Cs) :-
Cs0 == [],
@@ -163,6 +211,9 @@ user:goal_expansion(phrase(GRBody, S, S0), GRBody2) :-
E,
dcgs:error_goal(E, GRBody1)
),
module_call_qualified(M, GRBody1, GRBody2).
( GRBody = (_:_) ->
GRBody2 = M:GRBody1
; GRBody2 = GRBody1
).
user:goal_expansion(phrase(GRBody, S), phrase(GRBody, S, [])).

View File

@@ -1,4 +1,22 @@
% Source: https://stackoverflow.com/a/30791637
/** Declarative debugging.
This library provides three predicates with associated operators.
The operators can be placed in front of goals to debug Prolog
programs.
Of these predicates, the most frequently used is `(*)/1`, with
associated prefix operator `*` (star). Placing `*` in front of a
goal means to _generalize away_ the goal. `* Goal` acts as if `Goal`
did not appear at all in the source code. It is declaratively
equivalent to _commenting out_ the goal, and easier to write,
because `*` can also be placed in front of the last goal in a clause
without any additional changes.
Source: [https://stackoverflow.com/a/30791637](https://stackoverflow.com/a/30791637)
*/
:- module(debug, [
op(900, fx, $),
@@ -15,12 +33,25 @@
:- meta_predicate $(0).
:- meta_predicate $-(0).
%% $-(Goal)
%
% Portray exceptions thrown by Goal.
$-(G_0) :-
catch(G_0, Ex, ( portray_clause(exception:Ex:G_0), throw(Ex) ) ).
%% $(Goal)
%
% Provide a _trace_ for calls of Goal.
$(G_0) :-
portray_clause(call:G_0),
$-G_0,
portray_clause(exit:G_0).
%% *(Goal)
%
% Generalize away Goal.
*(_).

View File

@@ -1,7 +1,160 @@
:- module(diag, [wam_instructions/2]).
:- module(diag, [wam_instructions/2, inlined_instructions/2]).
/** Diagnostics library
The predicate `wam_instructions/2` _decompiles_ a predicate so that
we can inspect its Warren Abstract Machine (WAM) instructions.
In this way, we can verify and reason about compiled programs,
and detect opportunities for optimization.
For example, we have:
```
?- use_module(library(lists)).
true.
?- use_module(library(diag)).
true.
?- use_module(library(format)).
true.
?- wam_instructions(append/3, Is),
maplist(portray_clause, Is).
switch_on_term(1,external(1),external(2),external(6),fail).
try_me_else(4).
get_constant(level(shallow),[],x(1)).
get_value(x(2),3).
proceed.
trust_me(0).
get_list(level(shallow),x(1)).
unify_variable(x(4)).
unify_variable(x(1)).
get_list(level(shallow),x(3)).
unify_value(x(4)).
unify_variable(x(3)).
execute(append,3).
Is = [switch_on_term(1,external(1),external(2),external(6),fail)|...].
```
`inlined_instructions/2` decompiles predicates at the code offset in
its first argument.
For example, given the program
```
?- [user].
:- use_module(library(clpz)).
all_eq(Vs, E) :- maplist(#=(E), Vs).
```
we inspect the code of `all_eqs/2` using `wam_instructions/2`,
revealing:
```
?- wam_instructions(all_eq/2, Is),
maplist(portray_clause, Is).
put_structure('$aux',2,x(3)).
set_local_value(x(2)).
set_void(1).
set_constant('$index_ptr'(115334)).
get_variable(x(4),1).
put_structure(:,2,x(1)).
set_constant(user).
set_local_value(x(3)).
get_variable(x(5),2).
put_value(x(4),2).
execute(maplist,2).
Is = [put_structure('$aux',2,x(3)),set_local_value(x(2)),set_void(1),set_constant('$index_ptr'(115334)),get_variable(x(4),1),put_structure(:,2,x(1)),set_constant(user),set_local_value(x(3)),get_variable(x(5),2),put_value(x(4),2),execute(maplist,2)].
```
The `'$index_ptr(115334)` functor gives a code offset to an inlined
predicate compiled for the use of maplist/2. `inlined_instructions/2`
can be used to decompile its source code:
```
?- inlined_instructions(115334, Is),
maplist(portray_clause, Is).
allocate(1).
get_level(y(1)).
get_variable(x(5),2).
put_value(x(3),2).
get_variable(x(6),3).
put_value(x(5),3).
put_unsafe_value(1,4).
deallocate.
jmp_by_execute(1).
try_me_else(8).
call(integer,1).
neck_cut.
get_variable(x(5),1).
put_value(x(2),1).
get_variable(x(6),2).
put_value(x(5),2).
jmp_by_execute(7).
try_me_else(12).
allocate(3).
get_level(y(1)).
get_variable(y(3),1).
get_variable(y(2),2).
call_default(true,0).
call(var,1).
cut(y(1)).
put_unsafe_value(3,1).
put_unsafe_value(2,2).
deallocate.
execute_default(is,2).
default_retry_me_else(4).
call(integer,1).
neck_cut.
execute(=:=,2).
default_trust_me(0).
allocate(2).
get_variable(y(1),1).
get_variable(y(2),3).
put_value(y(2),1).
call_default(is,2).
put_unsafe_value(2,1).
put_unsafe_value(1,2).
deallocate.
execute_default(clpz_equal,2).
default_retry_me_else(4).
call(integer,1).
neck_cut.
jmp_by_execute(29).
try_me_else(12).
allocate(3).
get_level(y(1)).
get_variable(y(3),1).
get_variable(y(2),2).
call_default(true,0).
call(var,1).
cut(y(1)).
put_unsafe_value(3,1).
put_unsafe_value(2,2).
deallocate.
execute_default(is,2).
default_trust_me(0).
allocate(2).
get_variable(y(2),1).
get_variable(y(1),3).
put_value(y(1),1).
call_default(is,2).
put_unsafe_value(2,1).
put_unsafe_value(1,2).
deallocate.
execute_default(clpz_equal,2).
default_trust_me(0).
execute_default(clpz_equal,2).
Is = [allocate(1),get_level(y(1)),get_variable(x(5),2),put_value(x(3),2),get_variable(x(6),3),put_value(x(5),3),put_unsafe_value(1,4),deallocate,jmp_by_execute(1),try_me_else(8),call(integer,1),neck_cut,get_variable(x(5),1),put_value(x(2),1),get_variable(x(6),2),put_value(x(5),2),jmp_by_execute(7),try_me_else(12),allocate(3),get_level(...),...].
```
*/
:- use_module(library(error)).
%% wam_instructions(+PI, -Instrs)
%
% _Instrs_ are the WAM instructions corresponding to predicate indicator _PI_.
wam_instructions(Clause, Listing) :-
( nonvar(Clause) ->
@@ -13,6 +166,16 @@ wam_instructions(Clause, Listing) :-
; throw(error(instantiation_error, wam_instructions/2))
).
%% inlined_instructions(+IndexPtr, -Instrs)
%
% _Instrs_ are the WAM instructions corresponding to code offset _IndexPtr_.
inlined_instructions(IndexPtr, Listing) :-
must_be(integer, IndexPtr),
( IndexPtr >= 0 ->
'$inlined_instructions'(IndexPtr, Listing)
; throw(error(domain_error(not_less_than_zero, IndexPtr), inlined_instructions/2))
).
fetch_instructions(Module, Name, Arity, Listing) :-
must_be(atom, Module),

View File

@@ -1,8 +1,13 @@
/**
Provides predicate `dif/2`. `dif/2` is a constraint that is true only if both of its
arguments are different terms.
*/
:- module(dif, [dif/2]).
:- use_module(library(atts)).
:- use_module(library(dcgs)).
:- use_module(library(lists), [append/3]).
:- use_module(library(lists), [append/3, maplist/3]).
:- attribute dif/1.
@@ -18,6 +23,32 @@ dif_set_variables([Var|Vars], X, Y) :-
put_dif_att(Var, X, Y),
dif_set_variables(Vars, X, Y).
remove_goal([], _, []).
remove_goal([G0|G0s], Goal0, Goals) :-
( G0 == Goal0 ->
remove_goal(G0s, Goal0, Goals)
; Goals = [G0|Goals1],
remove_goal(G0s, Goal0, Goals1)
).
vars_remove_goal([], _).
vars_remove_goal([Var|Vars], Goal0) :-
get_atts(Var, +dif(Goals0)),
remove_goal(Goals0, Goal0, Goals),
( Goals = [] ->
put_atts(Var, -dif(_))
; put_atts(Var, +dif(Goals))
),
vars_remove_goal(Vars, Goal0).
reinforce_goal(Goal0, Goal) :-
Goal = (
term_variables(Goal0, Vars),
dif:vars_remove_goal(Vars, Goal0),
Goal0 = (L \== R),
dif:dif(L, R)
).
append_goals([], _).
append_goals([Var|Vars], Goals) :-
( get_atts(Var, +dif(VarGoals)) ->
@@ -29,31 +60,46 @@ append_goals([Var|Vars], Goals) :-
append_goals(Vars, Goals).
verify_attributes(Var, Value, Goals) :-
( get_atts(Var, +dif(Goals)) ->
( get_atts(Var, +dif(Goals0)) ->
term_variables(Value, ValueVars),
append_goals(ValueVars, Goals)
append_goals(ValueVars, Goals0),
maplist(reinforce_goal, Goals0, Goals)
; Goals = []
).
% Probably the world's worst dif/2 implementation. I'm open to
% suggestions for improvement.
%% dif(?X, ?Y).
%
% True iff X and Y are different terms. Unlike `\=/2`, `dif/2` is more declarative because if X and Y can
% unify but they're not yet equal, the decision is delayed, and prevents X and Y to become equal later.
% Examples:
%
% ```
% ?- dif(a, a).
% false.
% ?- dif(a, b).
% true.
% ?- dif(X, b).
% dif:dif(X,b).
% ?- dif(X, b), X = b.
% false.
% ```
dif(X, Y) :-
X \== Y,
( X \= Y -> true
; ( term_variables(X, XVars),
term_variables(Y, YVars),
dif_set_variables(XVars, X, Y),
dif_set_variables(YVars, X, Y)
)
; term_variables(dif(X,Y), Vars),
dif_set_variables(Vars, X, Y)
).
gather_dif_goals([]) --> [].
gather_dif_goals([(X \== Y) | Goals]) -->
[dif:dif(X, Y)],
gather_dif_goals(Goals).
gather_dif_goals(_, []) --> [].
gather_dif_goals(V, [(X \== Y) | Goals]) -->
( { term_variables(X-Y, [V0 | _]),
V == V0 } ->
[dif:dif(X, Y)]
; []
),
gather_dif_goals(V, Goals).
attribute_goals(X) -->
{ get_atts(X, +dif(Goals)) },
gather_dif_goals(Goals),
gather_dif_goals(X, Goals),
{ put_atts(X, -dif(_)) }.

View File

@@ -1,5 +1,5 @@
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Written 2018-2022 by Markus Triska (triska@metalevel.at)
Written 2018-2023 by Markus Triska (triska@metalevel.at)
I place this code in the public domain. Use it in any way you want.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
@@ -85,11 +85,11 @@ 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).
must_be_(term, Term) :-
( \+ ground(Term) ->
instantiation_error(must_be/2)
; \+ acyclic_term(Term) ->
type_error(term, Term, must_be/2)
; true
( acyclic_term(Term) ->
( ground(Term) -> true
; instantiation_error(must_be/2)
)
; type_error(term, Term, must_be/2)
).
% We cannot use maplist(must_be(character), Cs), because library(lists)

104
src/lib/ffi.pl Normal file
View File

@@ -0,0 +1,104 @@
:- module(ffi, [use_foreign_module/2, foreign_struct/2]).
/** Foreign Function Interface
This module contains predicates used to call native code (exposed by the C ABI).
It uses [libffi](https://sourceware.org/libffi/) under the hood. The bridge is very simple
and is very unsafe and should be used with care. FFI isn't the only way to communicate with
the outside world in Prolog: sockets, pipes and HTTP may be good enough for your use case.
The main predicate is `use_foreign_module/2`. It takes a library name (which depending on the
operating system could be a `.so`, `.dylib` or `.dll` file). and a list of functions. Each
function is defined by its name, a list of the type of the arguments, and the return argument.
Types available are: `sint8`, `uint8`, `sint16`, `uint16`, `sint32`, `uint32`, `sint64`,
`uint64`, `f32`, `f64`, `cstr`, `void`, `bool`, `ptr` and custom structs, which can be defined
with `foreign_struct/2`.
After that, each function on the lists maps to a predicate created in the ffi module which
are used to call the native code.
The predicate takes the functor name after the function name. Then, the arguments are the input
arguments followed by a return argument. However, functions with return type `void` or `bool`
don't have that return argument. Predicates with `void` always succeed and `bool` predicates depend
on the return value on the native side.
```
ffi:FUNCTION_NAME(+InputArg1, ..., +InputArgN, -ReturnArg). % for all return types except void and bool
ffi:FUNCTION_NAME(+InputArg1, ..., +InputArgN). % for void and bool
```
## Example
For example, let's see how to define a function from the [raylib](https://www.raylib.com/) library.
```
?- use_foreign_module("./libraylib.so", ['InitWindow'([sint32, sint32, cstr], void)]).
```
This creates a `'InitWindow'` predicate under the ffi module. Now, we can call it:
```
?- ffi:'InitWindow'(800, 600, "Scryer Prolog + Raylib").
```
And a new window should pop up!
*/
:- use_module(library(lists)).
:- use_module(library(error)).
%% foreign_struct(+Name, +Elements).
%
% Defines a new struct type with name Name, composed of the elements Elements, which is a list
% of other types.
%
% The name of the types doesn't matter, but the order of Elements must match the ones in the
% native code.
%
% Example:
%
% ```
% ?- foreign_struct(color, [uint8, uint8, uint8, uint8]).
% ```
foreign_struct(Name, Elements) :-
'$define_foreign_struct'(Name, Elements).
use_foreign_module(LibName, Predicates) :-
'$load_foreign_lib'(LibName, Predicates),
maplist(assert_predicate, Predicates).
assert_predicate(PredicateDefinition) :-
PredicateDefinition =.. [Name, Inputs, void],
length(Inputs, NumInputs),
functor(Head, Name, NumInputs),
term_variables(Head, TermList),
Body = (
'$foreign_call'(Name, TermList, _),!
),
Predicate = (Head:-Body),
assertz(ffi:Predicate).
assert_predicate(PredicateDefinition) :-
PredicateDefinition =.. [Name, Inputs, bool],
length(Inputs, NumInputs),
functor(Head, Name, NumInputs),
term_variables(Head, TermList),
Body = (
'$foreign_call'(Name, TermList, 1),!
),
Predicate = (Head:-Body),
assertz(ffi:Predicate).
assert_predicate(PredicateDefinition) :-
PredicateDefinition =.. [Name, Inputs, Return],
\+ member(Return, [void, bool]),
length(Inputs, NumInputs),
NumArgs is NumInputs + 1,
functor(Head, Name, NumArgs),
term_variables(Head, TermList),
Body = (
lists:append(TermListInputs, [TermListReturn], TermList),
'$foreign_call'(Name, TermListInputs, TermListReturn),!
),
Predicate = (Head:-Body),
assertz(ffi:Predicate).

View File

@@ -1,3 +1,22 @@
/** Predicates for reasoning about files and directories.
In this library, directories and files are represented as
_lists of characters_. This is an ideal representation:
* Lists of characters can be conveniently reasoned about with DCGs
and built-in Prolog predicates from `library(lists)`. This alone
is already a very compelling argument to use them.
* Other Scryer libraries such as `library(http/http_open)` also already
use lists of characters to represent paths.
* File names are mostly ephemeral, so it is good for efficiency
that they can quickly allocated transiently on the heap, leaving the
atom table mostly unaffected. Indexing is almost never needed
for file names. If needed, it should be added to the engine.
* The previous point is also good for security, since the system
leaves little trace of which files were even accessed.
* Scryer Prolog represents lists of characters extremely compactly.
*/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Written 2020, 2022 by Markus Triska (triska@metalevel.at)
Part of Scryer Prolog.
@@ -51,8 +70,9 @@
file_exists/1,
directory_exists/1,
delete_file/1,
rename_file/2,
delete_directory/1,
rename_file/2,
file_copy/2,
delete_directory/1,
make_directory/1,
make_directory_path/1,
working_directory/2,
@@ -67,41 +87,82 @@
:- use_module(library(charsio)).
:- use_module(library(dcgs)).
%% directory_files(+Directory, -Files).
%
% Returns the list of files *and* directories available at a specific
% directory in the current system.
directory_files(Directory, Files) :-
must_be(chars, Directory),
can_be(list, Files),
'$directory_files'(Directory, Files).
%% file_size(+File, -Size).
%
% Returns the size (in bytes) of a file. The file must exist.
file_size(File, Size) :-
file_must_exist(File, file_size/2),
can_be(integer, Size),
'$file_size'(File, Size).
%% file_exists(+File).
%
% Succeeds if File is a file that exists in the current system.
file_exists(File) :-
must_be(chars, File),
'$file_exists'(File).
%% directory_exists(+Directory).
%
% Succeeds if Directory is a directory that exists in the current system.
directory_exists(Directory) :-
must_be(chars, Directory),
'$directory_exists'(Directory).
%% make_directory(+Directory).
%
% Succeeds if it creates a new directory named Directory in the current system.
% If you want to create a nested directory, use `make_directory_path/1`.
make_directory(Directory) :-
must_be(chars, Directory),
'$make_directory'(Directory).
%% make_directory_path(+Directory).
%
% Similar to `make_directory/1` but recursively creates directories if they're missing.
% Equivalent to mkdir -p in Unix.
make_directory_path(Directory) :-
must_be(chars, Directory),
'$make_directory_path'(Directory).
%% delete_file(+File).
%
% Succeeds if deletes File from the current system.
delete_file(File) :-
file_must_exist(File, delete_file/1),
'$delete_file'(File).
%% rename_file(+File, +Renamed).
%
% Succeeds if File is renamed to Renamed
rename_file(File, Renamed) :-
file_must_exist(File, rename_file/2),
must_be(chars, Renamed),
'$rename_file'(File, Renamed).
%% file_copy(+File, +Copied).
%
% Succeeds if File is copied to Copied
file_copy(File, Copied) :-
file_must_exist(File, file_copy/2),
must_be(chars, Copied),
'$file_copy'(File, Copied).
%% delete_directory(+Directory).
%
% Succeeds if Directory is deleted from the current system.
% Directory must be empty.
delete_directory(Directory) :-
directory_must_exist(Directory, delete_directory/1),
must_be(chars, Directory),
@@ -117,31 +178,31 @@ directory_must_exist(Directory, Context) :-
; throw(error(existence_error(directory, Directory), Context))
).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Dir0 is the current working directory, and the working directory
is changed to Dir.
Use working_directory(Ds, Ds) to determine the current working directory,
and leave it as is.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
%% workind_directory(Dir0, Dir).
%
% Dir0 is the current working directory, and the working directory
% is changed to Dir.
%
% Use `working_directory/2` to determine the current working directory,
% and leave it as is.
working_directory(Dir0, Dir) :-
can_be(list, Dir0),
can_be(list, Dir),
'$working_directory'(Dir0, Dir).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
True iff Cs is the canonical, absolute path of Ps.
All intermediate components are normalized, and all symbolic links
are resolved.
The predicate fails in the following situations, though not
necessarily *only* in these cases:
1. Ps is a path that does not exist.
2. A non-final component in Ps is not a directory.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
%% path_canonical(Ps, Cs).
%
% True iff Cs is the canonical, absolute path of Ps.
%
% All intermediate components are normalized, and all symbolic links
% are resolved.
%
% The predicate fails in the following situations, though not
% necessarily *only* in these cases:
%
% 1. Ps is a path that does not exist.
% 2. A non-final component in Ps is not a directory.
path_canonical(Ps, Cs) :-
must_be(chars, Ps),
@@ -155,12 +216,27 @@ path_canonical(Ps, Cs) :-
For two time stamps A and B, if A precedes B, then A @< B holds.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
%% file_modification_time(+File, -T).
%
% For a file File that must exist, it returns a time stamp T with the modification time
%
% T is a time stamp compatible with `library(time)`.
file_modification_time(File, T) :-
file_time_(File, modification, T).
%% file_access_time(+File, -T).
%
% For a file File that must exist, it returns a time stamp T with the access time
%
% T is a time stamp compatible with `library(time)`.
file_access_time(File, T) :-
file_time_(File, access, T).
%% file_creation_time(+File, -T).
%
% For a file File that must exist, it returns a time stamp T with the creation time
%
% T is a time stamp compatible with `library(time)`.
file_creation_time(File, T) :-
file_time_(File, creation, T).
@@ -170,29 +246,31 @@ file_time_(File, Which, T) :-
read_from_chars(T0, T).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
path_segments(Ps, Segments): True iff Segments are the segments of Ps.
Segments is the list of components of the path Ps that are
separated by the platform-specific directory separator. Each
segment is a list of characters.
At least one of the arguments must be instantiated.
Examples:
?- path_segments("/hello/there", Segments).
Segments = [[],"hello","there"].
?- path_segments(Path, ["hello","there"]).
Path = "hello/there".
To obtain the platform-specific directory separator, you can use:
?- path_segments(Separator, ["",""]).
Separator = "/".
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
%% path_segments(Ps, Segments).
%
% True iff Segments are the segments of Ps.
%
% Segments is the list of components of the path Ps that are
% separated by the platform-specific directory separator. Each
% segment is a list of characters.
%
% At least one of the arguments must be instantiated.
%
% Examples:
%
% ```
% ?- path_segments("/hello/there", Segments).
% Segments = [[],"hello","there"].
% ?- path_segments(Path, ["hello","there"]).
% Path = "hello/there".
% ```
%
% To obtain the platform-specific directory separator, you can use:
%
% ```
% ?- path_segments(Separator, ["",""]).
% Separator = "/".
% ```
path_segments(Path, Segments) :-
'$directory_separator'(Sep),

View File

@@ -1,83 +1,17 @@
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Written 2020, 2021, 2022 by Markus Triska (triska@metalevel.at)
Written 2020-2023 by Markus Triska (triska@metalevel.at)
Part of Scryer Prolog.
This library provides the nonterminal format_//2 to describe
formatted strings. format/[2,3] are provided for impure output.
Usage:
======
phrase(format_(FormatString, Arguments), Ls)
format_//2 describes a list of characters Ls that are formatted
according to FormatString. FormatString is a string (i.e.,
a list of characters) that specifies the layout of Ls.
The characters in FormatString are used literally, except
for the following tokens with special meaning:
~w use the next available argument from Arguments here
~q use the next argument here, formatted as by writeq/1
~a use the next argument here, which must be an atom
~s use the next argument here, which must be a string
~d use the next argument here, which must be an integer
~f use the next argument here, a floating point number
~Nf where N is an integer: format the float argument
using N digits after the decimal point
~Nd like ~d, placing the last N digits after a decimal point;
if N is 0 or omitted, no decimal point is used.
~ND like ~Nd, separating digits to the left of the decimal point
in groups of three, using the character "," (comma)
~NU like ~ND, using "_" (underscore) to separate groups of digits
~NL format an integer so that at most N digits appear on a line.
If N is 0 or omitted, it defaults to 72.
~Nr where N is an integer between 2 and 36: format the
next argument, which must be an integer, in radix N.
The characters "a" to "z" are used for radices 10 to 36.
If N is omitted, it defaults to 8 (octal).
~NR like ~Nr, except that "A" to "Z" are used for radices > 9
~| place a tab stop at this position
~N| where N is an integer: place a tab stop at text column N
~N+ where N is an integer: place a tab stop N characters
after the previous tab stop (or start of line)
~t distribute spaces evenly between the two closest tab stops
~`Ct like ~t, use character C instead of spaces to fill the space
~n newline
~Nn N newlines
~i ignore the next argument
~~ the literal ~
Instead of ~N, you can write ~* to use the next argument from Arguments
as the numeric argument.
The predicate format/2 is like format_//2, except that it outputs
the text on the terminal instead of describing it declaratively.
format/3, used as format(Stream, FormatString, Arguments), outputs
the described string to the given Stream. If Stream is a binary
stream, then the code of each emitted character must be in 0..255.
If at all possible, format_//2 should be used, to stress pure parts
that enable easy testing etc. If necessary, you can emit the list Ls
with maplist(put_char, Ls) or, much faster, with format("~s", [Ls]).
Ideally, however, you use phrase_to_file/[2,3] or phrase_to_stream/2
from library(pio) to write the described list directly to a file
or stream, respectively: phrase_to_stream(format_(..., [...]), S).
The advantage of this is that an ideal implementation writes
the characters as they become known, without manifesting the list.
The entire library only works if the Prolog flag double_quotes
is set to chars, the default value in Scryer Prolog. This should
also stay that way, to encourage a sensible environment.
Example:
?- phrase(format_("~s~n~`.t~w!~12|", ["hello",there]), Cs).
%@ Cs = "hello\n......there!".
I place this code in the public domain. Use it in any way you want.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/** This library provides the nonterminal `format_//2` to describe
formatted strings. `format/[2,3]` are provided for _impure_ output.
The entire library only works if the Prolog flag `double_quotes`
is set to `chars`, the default value in Scryer Prolog. This should
also stay that way, to encourage a sensible environment.
*/
:- module(format, [format_//2,
format/2,
format/3,
@@ -94,6 +28,61 @@
:- use_module(library(between)).
:- use_module(library(pio)).
%% format_(+FormatString, +Arguments)//
%
% Usage:
%
% ```
% phrase(format_(FormatString, Arguments), Ls)
% ```
%
% `format_//2` describes a list of characters Ls that are formatted
% according to FormatString. FormatString is a string (i.e., a list of
% characters) that specifies the layout of Ls. The characters in
% FormatString are used literally, except for the following tokens
% with special meaning:
%
% | `~w` | use the next available argument from Arguments here |
% | `~q` | use the next argument here, formatted as by `writeq/1` |
% | `~a` | use the next argument here, which must be an atom |
% | `~s` | use the next argument here, which must be a string |
% | `~d` | use the next argument here, which must be an integer |
% | `~f` | use the next argument here, a floating point number |
% | `~Nf` | where N is an integer: format the float argument |
% | | using N digits after the decimal point |
% | `~Nd` | like ~d, placing the last N digits after a decimal point; |
% | | if N is 0 or omitted, no decimal point is used. |
% | `~ND` | like ~Nd, separating digits to the left of the decimal point |
% | | in groups of three, using the character "," (comma) |
% | `~NU` | like ~ND, using "_" (underscore) to separate groups of digits |
% | `~NL` | format an integer so that at most N digits appear on a line. |
% | | If N is 0 or omitted, it defaults to 72. |
% | `~Nr` | where N is an integer between 2 and 36: format the |
% | | next argument, which must be an integer, in radix N. |
% | | The characters "a" to "z" are used for radices 10 to 36. |
% | | If N is omitted, it defaults to 8 (octal). |
% | `~NR` | like ~Nr, except that "A" to "Z" are used for radices > 9 |
% | `~|` | place a tab stop at this position |
% | `~N|` | where N is an integer: place a tab stop at text column N |
% | `~N+` | where N is an integer: place a tab stop N characters |
% | | after the previous tab stop (or start of line) |
% | `~t` | distribute spaces evenly between the two closest tab stops |
% | ``~`Ct`` | like ~t, use character C instead of spaces to fill the space |
% | `~n` | newline |
% | `~Nn` | N newlines |
% | `~i` | ignore the next argument |
% | `~~` | the literal ~ |
%
% Instead of `~N`, you can write `~*` to use the next argument from
% Arguments as the numeric argument.
%
% Example:
%
% ```
% ?- phrase(format_("~s~n~`.t~w!~12|", ["hello",there]), Cs).
% Cs = "hello\n......there!".
% ```
format_(Fs, Args) -->
{ must_be(list, Fs),
must_be(list, Args),
@@ -414,10 +403,32 @@ digits(uppercase, "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ").
Impure I/O, implemented as a small wrapper over format_//2.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
%% format(+Fs, +Args)
%
% The predicate `format/2` is like `format_//2`, except that it
% outputs the text on the terminal instead of describing it
% declaratively as a list of characters.
%
% If at all possible, `format_//2` should be used, to stress pure
% parts that enable easy testing etc. If necessary, you can emit the
% described list of characters `Ls` with `maplist(put_char, Ls)` or,
% much faster, with `format("~s", [Ls])`. Ideally, however, you use
% `phrase_to_file/[2,3]` or `phrase_to_stream/2` from `library(pio)`
% to write the described list directly to a file or stream,
% respectively: `phrase_to_stream(format_(..., [...]), S)`. The
% advantage of this is that an ideal implementation writes the
% characters as they become known, without manifesting the list.
format(Fs, Args) :-
current_output(Stream),
format(Stream, Fs, Args).
%% format(Stream, FormatString, Arguments)
%
% Output the described string to the given Stream. If Stream is a
% binary stream, then the code of each emitted character must be in
% 0..255.
format(Stream, Fs, Args) :-
phrase_to_stream(format_(Fs, Args), Stream),
flush_output(Stream).
@@ -486,11 +497,14 @@ aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
In the eventual library organization, portray_clause/1 and
related predicates may be placed in their own dedicated library.
portray_clause/1 is useful for printing solutions in such a way
that they can be read back with read/1.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
%% portray_clause(+Term)
%
% `portray_clause/1` is useful for printing solutions in such a way
% that they can be read back with `read/1`.
portray_clause(Term) :-
current_output(Out),
portray_clause(Out, Term).
@@ -512,7 +526,7 @@ var_name(V, Name=V, Num0, Num) :-
Num is Num0 + 1.
literal(Lit, VNs) -->
{ write_term_to_chars(Lit, [quoted(true),variable_names(VNs)], Ls) },
{ write_term_to_chars(Lit, [quoted(true),variable_names(VNs),double_quotes(true)], Ls) },
seq(Ls).
portray_(Var, VNs) --> { var(Var) }, !, literal(Var, VNs).

View File

@@ -1,5 +1,8 @@
:- module(freeze, [freeze/2]).
/** Provides the constraint `freeze/2`.
*/
:- use_module(library(atts)).
:- use_module(library(dcgs)).
@@ -19,6 +22,15 @@ verify_attributes(Var, Other, Goals) :-
).
verify_attributes(_, _, []).
%% freeze(Var, Goal)
%
% Schedules Goal to be executed when Var is instantiated. This can
% be useful to observe the exact moment a variable becomes bound to a
% more concrete term, for example when creating animations of search
% processes. Higher-level constructs such as `phrase_from_file/2` can
% also be implemented with `freeze/2`, by scheduling a goal that
% reads additional data from a file as soon as it is needed.
freeze(X, Goal) :-
put_atts(Fresh, frozen(Goal)),
Fresh = X.
@@ -26,5 +38,5 @@ freeze(X, Goal) :-
attribute_goals(Var) -->
{ get_atts(Var, frozen(Goals)),
put_atts(Var, -frozen(_)) },
[freeze(Var, Goals)].
[freeze:freeze(Var, Goals)].

View File

@@ -19,14 +19,14 @@ gensym(Base, Unique) :-
must_be(var, Unique),
atom_si(Base),
gensym_key(Base, BaseKey),
( bb_get(BaseKey, UniqueID0) ->
UniqueID is UniqueID0 + 1,
bb_put(BaseKey, UniqueID),
append_id(Base, UniqueID, Unique)
; bb_put(BaseKey, 1),
append_id(Base, 1, Unique)
).
( bb_get(BaseKey, UniqueID0) -> true
; UniqueID0 = 0
),
UniqueID is UniqueID0 + 1,
append_id(Base, UniqueID, Unique),
bb_put(BaseKey, UniqueID).
reset_gensym(Base) :-
atom_si(Base),
bb_put(Base, 0).
gensym_key(Base, BaseKey),
bb_put(BaseKey, 0).

View File

@@ -1,34 +1,39 @@
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Written 2022 by Adrián Arroyo Calle (adrian.arroyocalle@gmail.com)
Part of Scryer Prolog.
*/
http_open(+Address, -Stream, +Options)
======================================
/** Make HTTP requests.
Yields Stream to read the body of an HTTP reply from Address.
Address is a list of characters, and includes the method. Both HTTP
and HTTPS are supported.
Options supported:
* method(+Method): Sets the HTTP method of the call. Method can be get (default), head, delete, post, put or patch.
* data(+Data): Data to be sent in the request. Useful for POST, PUT and PATCH operations.
* size(-Size): Unifies with the value of the Content-Length header
* request_headers(+RequestHeaders): Headers to be used in the request
* headers(-ListHeaders): Unifies with a list with all headers returned in the response
* status_code(-Code): Unifies with the status code of the request (200, 201, 404, ...)
Example:
?- http_open("https://github.com/mthom/scryer-prolog", S, []).
%@ S = '$stream'(0x7fcfc9e00f00).
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
This library contains the predicate `http_open/3` which allows you to perform HTTP(S) calls.
Useful for making API calls, or parsing websites. It uses Hyper underneath.
*/
:- module(http_open, [http_open/3]).
:- use_module(library(lists)).
%% http_open(+Address, -Stream, +Options).
%
% Yields Stream to read the body of an HTTP reply from Address.
% Address is a list of characters, and includes the method. Both HTTP
% and HTTPS are supported.
%
% Options supported:
%
% * `method(+Method)`: Sets the HTTP method of the call. Method can be `get` (default), `head`, `delete`, `post`, `put` or `patch`.
% * `data(+Data)`: Data to be sent in the request. Useful for POST, PUT and PATCH operations.
% * `size(-Size)`: Unifies with the value of the Content-Length header
% * `request_headers(+RequestHeaders)`: Headers to be used in the request
% * `headers(-ListHeaders)`: Unifies with a list with all headers returned in the response
% * `status_code(-Code)`: Unifies with the status code of the request (200, 201, 404, ...)
%
% Example:
%
% ```
% ?- http_open("https://www.example.com", S, []), get_n_chars(S, N, HTML).
% S = '$stream'(0x7fb548001be8), N = 1256, HTML = "<!doctype html>\n<ht ...".
% ```
http_open(Address, Response, Options) :-
parse_http_options(Options, OptionValues),
( member(method(Method), OptionValues) -> true; Method = get),
@@ -65,4 +70,4 @@ parse_http_options_(request_headers(Headers), request_headers(Headers)) :-
parse_http_options_(size(Size), size(Size)).
parse_http_options_(status_code(Code), status_code(Code)).
parse_http_options_(headers(Headers), headers(Headers)).
parse_http_options_(headers(Headers), headers(Headers)).

View File

@@ -1,63 +1,71 @@
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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 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
==========
The main predicate of the library is http_listen/2, which needs a port number
(usually 80) and a list of handlers. A handler is a compound term with the functor
as one HTTP method (in lowercase) and followed by a Route Match and a predicate
which will handle the call.
text_handler(Request, Response) :-
http_status_code(Response, 200),
http_body(Response, text("Welcome to Scryer Prolog!")).
parameter_handler(User, Request, Response) :-
http_body(Response, text(User)).
http_listen(7890, [
get(echo, text_handler), % GET /echo
post(user/User, parameter_handler(User)) % POST /user/<User>
]).
Every handler predicate will have at least 2-arity, with Request and Response.
Although you can work directly with http_request and http_response terms, it is
recommeded to use the helper predicates, which are easier to understand and cleaner:
- http_headers(Response/Request, Headers)
- http_status_code(Responde, StatusCode)
- http_body(Response/Request, text(Body))
- http_body(Response/Request, binary(Body))
- http_body(Request, form(Form))
- http_body(Response, file(Filename))
- http_redirect(Response, Url)
- http_query(Request, QueryName, QueryValue)
Some things that are still missing:
- Read forms in multipart format
- HTTP Basic Auth
- Session handling via cookies
- HTML Templating
Part of Scryer Prolog.
I place this code in the public domain. Use it in any way you want.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
*/
/** This library provides an starting point to build HTTP server based applications.
It is based on [Warp](https://github.com/seanmonstar/warp), which allows for HTTP/1.0, HTTP/1.1 and HTTP/2. However,
some advanced features that Warp provides are still not accesible.
## Usage
The main predicate of the library is `http_listen/2`, which needs a port number
(usually 80) and a list of handlers. A handler is a compound term with the functor
as one HTTP method (in lowercase) and followed by a Route Match and a predicate
which will handle the call.
```
text_handler(Request, Response) :-
http_status_code(Response, 200),
http_body(Response, text("Welcome to Scryer Prolog!")).
parameter_handler(User, Request, Response) :-
http_body(Response, text(User)).
http_listen(7890, [
get(echo, text_handler), % GET /echo
post(user/User, parameter_handler(User)) % POST /user/<User>
]).
```
Every handler predicate will have at least 2-arity, with Request and Response.
Although you can work directly with `http_request` and `http_response` terms, it is
recommeded to use the helper predicates, which are easier to understand and cleaner:
- `http_headers(Response/Request, Headers)`
- `http_status_code(Responde, StatusCode)`
- `http_body(Response/Request, text(Body))`
- `http_body(Response/Request, binary(Body))`
- `http_body(Request, form(Form))`
- `http_body(Response, file(Filename))`
- `http_redirect(Response, Url)`
- `http_query(Request, QueryName, QueryValue)`
Some things that are still missing:
- Read forms in multipart format
- Session handling via cookies
- HTML Templating (but you can use [Teruel](https://github.com/aarroyoc/teruel/), [Marquete](https://github.com/aarroyoc/marquete/) or [Djota](https://github.com/aarroyoc/djota) for that)
*/
:- module(http_server, [
http_listen/2,
http_listen/3,
http_headers/2,
http_status_code/2,
http_body/2,
http_redirect/2,
http_query/3
http_query/3,
http_basic_auth/4
]).
:- meta_predicate http_listen(?, :).
:- meta_predicate http_listen(?, :, ?).
:- meta_predicate http_basic_auth(:, :, ?, ?).
:- use_module(library(charsio)).
:- use_module(library(crypto)).
@@ -68,22 +76,60 @@
:- use_module(library(pio)).
:- use_module(library(time)).
%% http_listen(+Port, +Handlers).
%
% Equivalent to `http_listen(Port, Handlers, [])`.
http_listen(Port, Module:Handlers0) :-
must_be(integer, Port),
must_be(list, Handlers0),
maplist(module_qualification(Module), Handlers0, Handlers),
http_listen_(Port, Handlers).
http_listen_(Port, Handlers, []).
%% http_listen(+Port, +Handlers, +Options).
%
% Listens for HTTP connections on port Port. Each handler on the list Handlers should be of the form: `HttpVerb(PathUnification, Predicate)`.
% For example: `get(user/User, get_info(User))` will match an HTTP request that is a GET, the path unifies with /user/User (where User is a variable)
% and it will call `get_info` with three arguments: an `http_request` term, an `http_response` term and User.
%
% The following options are supported:
%
% - `tls_key(+Key)` - a TLS key for HTTPS (string)
% - `tls_cert(+Cert)` - a TLS cert for HTTPS (string)
% - `content_length_limit(+Limit)` - maximum length (in bytes) for the incoming bodies. By default, 32KB.
%
% In order to have a HTTPS server (instead of plain HTTP), both `tls_key` and `tls_cert` options must be provided.
http_listen(Port, Module:Handlers0, Options) :-
must_be(integer, Port),
must_be(list, Handlers0),
must_be(list, Options),
maplist(module_qualification(Module), Handlers0, Handlers),
http_listen_(Port, Handlers, Options).
module_qualification(M, H0, H) :-
H0 =.. [Method, Path, Goal],
H =.. [Method, Path, M:Goal].
http_listen_(Port, Handlers) :-
http_listen_(Port, Handlers, Options) :-
parse_options(Options, TLSKey, TLSCert, ContentLengthLimit),
phrase(format_("0.0.0.0:~d", [Port]), Addr),
'$http_listen'(Addr, HttpListener),!,
'$http_listen'(Addr, HttpListener, TLSKey, TLSCert, ContentLengthLimit),!,
format("Listening at ~s\n", [Addr]),
http_loop(HttpListener, Handlers).
parse_options(Options, TLSKey, TLSCert, ContentLengthLimit) :-
member_option_default(tls_key, Options, "", TLSKey),
member_option_default(tls_cert, Options, "", TLSCert),
member_option_default(content_length_limit, Options, 32768, ContentLengthLimit),
must_be(integer, ContentLengthLimit).
member_option_default(Key, List, _Default, Value) :-
X =.. [Key, Value],
member(X, List).
member_option_default(Key, List, Default, Default) :-
X =.. [Key, _],
\+ member(X, List).
http_loop(HttpListener, Handlers) :-
'$http_accept'(HttpListener, RequestMethod, RequestPath, RequestHeaders, RequestQuery, RequestStream, ResponseHandle),
current_time(Time),
@@ -105,44 +151,51 @@ http_loop(HttpListener, Handlers) :-
)
; (
'$http_answer'(ResponseHandle, 404, [], ResponseStream),
call_cleanup(format(ResponseStream, "Not Found"), close(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)
'$http_answer'(ResponseHandle, StatusCode, ResponseHeaders, ResponseStream0),
open(stream(ResponseStream0), write, ResponseStream, [type(text)]),
catch(
call_cleanup(format(ResponseStream, "~s", [ResponseText]),close(ResponseStream)),
error(existence_error(stream, _), _),
true
).
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)
catch(
call_cleanup(format(ResponseStream, "~s", [ResponseBytes]),close(ResponseStream)),
error(existence_error(stream, _), _),
true
).
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])
catch(
call_cleanup(
setup_call_cleanup(
open(Filename, read, FileStream, [type(binary)]),
(
get_n_chars(FileStream, _, FileCs),
format(ResponseStream, "~s", [FileCs])
),
close(FileStream)
),
close(FileStream)
close(ResponseStream)
),
close(ResponseStream)
error(existence_error(stream, _), _),
true
).
default(Var, Default, Out) :-
(var(Var) -> Out = Default
@@ -206,9 +259,21 @@ string_without(Not, [Char|String]) -->
string_without(_, []) -->
[].
%% http_headers(?Request_Response, ?Headers).
%
% True iff `Request_Response` is a request or response with headers Headers. Can be used both to get headers (usually in from a request)
% and to add headers (usually in a response).
http_headers(http_request(Headers, _, _), Headers).
http_headers(http_response(_, _, Headers), Headers).
%% http_body(?Request_Response, ?Body).
%
% True iff Body is the body of the request or response. A body can be of the following types:
%
% * `bytes(Bytes)` for both requests and responses, interprets the body as bytes
% * `text(Bytes)` for both requests and responses, interprets the body as text
% * `form(Form)` only for requests, interprets the body as an `application/x-www-form-urlencoded` form.
% * `file(File)` only for responses, interprets the body as the content of a file (useful to send static files).
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)) :-
@@ -218,31 +283,38 @@ http_body(http_request(Headers, stream(StreamBody), _), form(FormBody)) :-
http_body(http_request(_, Body, _), Body).
http_body(http_response(_, Body, _), Body).
%% http_status_code(?Response, ?StatusCode).
%
% True iff the status code of the response Response unifies with StatusCode.
http_status_code(http_response(StatusCode, _, _), StatusCode).
%% http_redirect(-Response, +Uri).
%
% True iff Response is a response that redirects the user to the uri Uri.
http_redirect(http_response(307, text("Moved Temporarily"), ["Location"-Uri]), Uri).
%% http_query(+Request, ?Key, ?Value).
%
% True iff there's a query in request Request with key Key and value Value.
http_query(http_request(_, _, Queries), Key, Value) :- member(Key-Value, Queries).
parse_queries([Key-Value|Queries]) -->
string_without("=", Key0),
{
phrase(url_decode(Key), Key0)
},
"=",
string_without("&", Value0),
{
phrase(url_decode(Value), Value0)
},
"&",
parse_queries(Queries).
parse_queries(Queries),
{
phrase(url_decode(Key), Key0),
phrase(url_decode(Value), Value0)
}.
parse_queries([Key-Value]) -->
string_without("=", Key0),
{
phrase(url_decode(Key), Key0)
},
"=",
string_without(" ", Value0),
{
phrase(url_decode(Key), Key0),
phrase(url_decode(Value), Value0)
}.
@@ -253,9 +325,13 @@ parse_queries([]) -->
url_decode([Char|Chars]) -->
[Char],
{
Char \= '%'
Char \= '%',
Char \= (+)
},
url_decode(Chars).
url_decode([' '|Chars]) -->
"+",
url_decode(Chars).
url_decode([Char|Chars]) -->
"%",
[A],
@@ -313,3 +389,49 @@ url_decode([Char|Chars]) -->
url_decode(Chars).
url_decode([]) --> [].
%% http_basic_auth(+LoginPredicate, +Handler, +Request, -Response)
%
% Metapredicate that wraps an existing Handler with an HTTP Basic Auth flow.
% Checks if a given user + password is authorized to execute that handler, returning 401
% if it's not satisfied.
%
% `LoginPredicate` must be a predicate of arity 2 that takes a User and a Password.
% `Handler` will have, in addition to the Request and Response arguments, a User argument
% containing the User given in the authentication.
%
% Example:
%
% ```
% main :-
% http_listen(8800,[get('/', http_basic_auth(login, inside_handler("data")))]).
%
% login(User, Pass) :-
% User = "aarroyoc",
% Pass = "123456".
%
% inside_handler(Data, User, Request, Response) :-
% http_body(Response, text(User)).
% ```
http_basic_auth(LoginPredicate, Handler, Request, Response) :-
http_headers(Request, Headers),
member("authorization"-AuthorizationStr, Headers),
append("Basic ", Coded, AuthorizationStr),
chars_base64(UserPass, Coded, []),
append(User, [':'|Password], UserPass),
(
call(LoginPredicate, User, Password) ->
call(Handler, User, Request, Response)
; http_basic_auth_unauthorized_response(Response)
).
http_basic_auth(_LoginPredicate, _Handler, Request, Response) :-
http_headers(Request, Headers),
\+ member("authorization"-_, Headers),
http_basic_auth_unauthorized_response(Response).
http_basic_auth_unauthorized_response(Response) :-
http_status_code(Response, 401),
http_headers(Response, ["www-authenticate"-"Basic realm=\"Scryer Prolog\", charset=\"UTF-8\""]),
http_body(Response, text("Unauthorized")).

View File

@@ -1,3 +1,9 @@
/** Useful general predicates that are not ISO standard yet
Predicates available here are similar to the ones defined in builtin.pl,
but they're not part of the ISO Prolog standard at the moment.
*/
:- module(iso_ext, [bb_b_put/2,
bb_get/2,
bb_put/2,
@@ -8,10 +14,12 @@
partial_string/3,
partial_string_tail/2,
setup_call_cleanup/3,
succ/2,
call_nth/2,
countall/2,
copy_term_nat/2,
asserta/2,
assertz/2]).
asserta/2,
assertz/2]).
:- use_module(library(error), [can_be/2,
domain_error/3,
@@ -22,25 +30,82 @@
:- meta_predicate(forall(0, 0)).
%% forall(Generate, Test).
%
% For all bindings possible by Generate, Test must be true.
%
% In this example, it checks that all numbers are even:
%
% ```
% ?- Ns = [2,4,6], forall(member(N, Ns), 0 is N mod 2).
% Ns = [2,4,6].
% ```
forall(Generate, Test) :-
\+ (Generate, \+ Test).
%% (non-)backtrackable global variables.
% (non-)backtrackable global variables.
%% bb_put(+Key, +Value).
%
% Sets a global variable named Key (must be an atom) with value Value.
% The global variable isn't backtrackable. Check `bb_b_put/2` for the
% backtrackable version.
%
% ```
% ?- bb_put(city, "Valladolid").
% true.
% ?- bb_get(city, X).
% X = "Valladolid".
% ```
%
% In this example one can understand the difference between `bb_put/2` and
% `bb_b_put/2`:
%
% ```
% ?- bb_put(city, "Valladolid"), (bb_put(city, "Salamanca"), false);(bb_get(city, X)).
% X = "Salamanca".
% ?- bb_put(city, "Valladolid"), (bb_b_put(city, "Salamanca"), false);(bb_get(city, X)).
% X = "Valladolid".
% ```
bb_put(Key, Value) :-
( atom(Key) ->
'$store_global_var'(Key, Value)
; type_error(atom, Key, bb_put/2)
).
%% backtrackable global variables.
% backtrackable global variables.
%% bb_b_put(+Key, +Value).
%
% Sets a global variable named Key (must be an atom) with value Value.
% The global variable is backtrackable. Check `bb_put/2` for the
% non-backtrackable version.
%
% ```
% ?- bb_b_put(city, "Valladolid").
% true.
% ?- bb_get(city, X).
% X = "Valladolid".
% ```
%
% In this example one can understand the difference between `bb_put/2` and
% `bb_b_put/2`:
%
% ```
% ?- bb_put(city, "Valladolid"), (bb_put(city, "Salamanca"), false);(bb_get(city, X)).
% X = "Salamanca".
% ?- bb_put(city, "Valladolid"), (bb_b_put(city, "Salamanca"), false);(bb_get(city, X)).
% X = "Valladolid".
% ```
bb_b_put(Key, Value) :-
( atom(Key) ->
'$store_backtrackable_global_var'(Key, Value)
; type_error(atom, Key, bb_b_put/2)
).
%% bb_get(+Key, -Value).
%
% Gets the value Value of a global variable named Key (must be an atom)
bb_get(Key, Value) :-
( atom(Key) ->
'$fetch_global_var'(Key, Value)
@@ -48,21 +113,51 @@ bb_get(Key, Value) :-
).
%% succ(?I, ?S).
%
% True iff S is the successor of the non-negative integer I.
% At least one of the arguments must be instantiated.
succ(I, S) :-
can_be(not_less_than_zero, I),
can_be(not_less_than_zero, S),
( integer(S) ->
S > 0,
I is S-1
; integer(I) ->
S is I+1
; instantiation_error(succ/2)
).
% setup_call_cleanup.
:- meta_predicate(call_cleanup(0, 0)).
%% call_cleanup(Goal, Cleanup).
%
% Executes Goal and then, either on success or failure, executes Cleanup.
% The success or failure of Cleanup is ignored and choice points created inside are destroyed.
call_cleanup(G, C) :- setup_call_cleanup(true, G, C).
:- meta_predicate(setup_call_cleanup(0, 0, 0)).
:- non_counted_backtracking setup_call_cleanup/3.
%% setup_call_cleanup(Setup, Goal, Cleanup).
%
% If Setup succeeds, Cleanup will be called after the execution of Goal. Goal itself can succeed or not.
%
% In this example, we use the predicate to always close an open file:
%
% ```
% ?- setup_call_cleanup(open(File, read, Stream), do_something_with_stream(Stream), close(Stream)).
% ```
setup_call_cleanup(S, G, C) :-
'$get_b_value'(B),
'$call_with_inference_counting'(call(S)),
'$set_cp_by_default'(B),
'$get_current_block'(Bb),
'$get_current_scc_block'(Bb),
( C = _:CC,
var(CC) ->
instantiation_error(setup_call_cleanup/3)
@@ -75,17 +170,16 @@ setup_call_cleanup(S, G, C) :-
scc_helper(C, G, Bb) :-
'$get_cp'(Cp),
'$install_scc_cleaner'(C, NBb),
'$install_scc_cleaner'(C),
'$call_with_inference_counting'(call(G)),
( '$check_cp'(Cp) ->
'$reset_block'(Bb),
'$reset_scc_block'(Bb),
run_cleaners_without_handling(Cp)
; true
; '$reset_block'(NBb),
'$fail'
; '$fail'
).
scc_helper(_, _, Bb) :-
'$reset_block'(Bb),
'$reset_scc_block'(Bb),
'$push_ball_stack',
run_cleaners_with_handling,
'$pop_from_ball_stack',
@@ -99,7 +193,7 @@ scc_helper(_, _, _) :-
run_cleaners_with_handling :-
'$get_scc_cleaner'(C),
'$get_level'(B),
'$get_cp'(B),
catch(C, _, true),
'$set_cp_by_default'(B),
run_cleaners_with_handling.
@@ -110,7 +204,7 @@ run_cleaners_with_handling :-
run_cleaners_without_handling(Cp) :-
'$get_scc_cleaner'(C),
'$get_level'(B),
'$get_cp'(B),
call(C),
'$set_cp_by_default'(B),
run_cleaners_without_handling(Cp).
@@ -120,30 +214,13 @@ run_cleaners_without_handling(Cp) :-
% call_with_inference_limit
:- non_counted_backtracking end_block/4.
end_block(_, Bb, NBb, _L) :-
'$clean_up_block'(NBb),
'$reset_block'(Bb).
end_block(B, _Bb, NBb, L) :-
'$install_inference_counter'(B, L, _),
'$reset_block'(NBb),
'$fail'.
:- non_counted_backtracking handle_ile/3.
handle_ile(B, inference_limit_exceeded(B), inference_limit_exceeded) :-
!,
'$pop_ball_stack'.
handle_ile(B, _, _) :-
'$remove_call_policy_check'(B),
'$pop_from_ball_stack',
'$unwind_stack'.
:- meta_predicate(call_with_inference_limit(0, ?, ?)).
:- non_counted_backtracking call_with_inference_limit/3.
%% call_with_inference_limit(Goal, Limit, Result).
%
% Similar to `call(Goal)` but it limits the number of inferences for each solution of Goal.
call_with_inference_limit(G, L, R) :-
( integer(L) ->
( L < 0 ->
@@ -159,8 +236,6 @@ call_with_inference_limit(G, L, R) :-
call_with_inference_limit(G, L, R, Bb, B),
'$remove_call_policy_check'(B).
install_inference_counter(B, L, Count0) :-
'$install_inference_counter'(B, L, Count0).
:- meta_predicate(call_with_inference_limit(0,?,?,?,?)).
@@ -168,24 +243,39 @@ 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),
'$install_inference_counter'(NBb, L, Count0),
'$call_with_inference_counting'(call(G)),
'$inference_level'(R, B),
'$remove_inference_counter'(B, Count1),
'$remove_inference_counter'(NBb, Count1),
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),
( '$clean_up_block'(NBb),
'$reset_block'(Bb)
; '$install_inference_counter'(NBb, Diff, _),
'$reset_block'(NBb),
'$fail'
).
call_with_inference_limit(_, _, R, Bb, B) :-
( '$inference_limit_exceeded' ->
R = inference_limit_exceeded
; true
),
handle_ile(B, Ball, R).
'$get_current_block'(NBb),
'$remove_inference_counter'(NBb, _),
'$reset_block'(Bb),
'$remove_call_policy_check'(B),
( '$get_ball'(_),
'$push_ball_stack',
'$get_cp'(Cp),
'$set_cp_by_default'(Cp),
'$pop_from_ball_stack',
'$unwind_stack'
; nonvar(R)
).
%% partial_string(String, L, L0)
%
% Explicitly construct a partial string "manually". It can be used as an optimized append/3.
% It's not recommended to use this predicate in application code.
partial_string(String, L, L0) :-
( String == [] ->
L = L0
@@ -195,9 +285,17 @@ partial_string(String, L, L0) :-
'$create_partial_string'(Atom, L, L0)
).
%% partial_string(+String)
%
% Succeeds if String is a _partial string_. A partial string is a string composed of several smaller
% strings, even just one. That means all strings in Scryer are partial strings.
partial_string(String) :-
'$is_partial_string'(String).
%% partial_string_tail(+String, -Tail).
%
% Unifies Tail with the last section of the partial string.
% It's not recommended to use this predicate in application code.
partial_string_tail(String, Tail) :-
( partial_string(String) ->
'$partial_string_tail'(String, Tail)
@@ -209,6 +307,9 @@ partial_string_tail(String, Tail) :-
:- meta_predicate(call_nth(0, ?)).
%% call_nth(Goal, N).
%
% Succeeds when Goal succeeded for the Nth time (there are at least N solutions)
call_nth(Goal, N) :-
can_be(integer, N),
( integer(N) ->
@@ -246,17 +347,55 @@ call_nth_nesting(C, ID) :-
bb_put(ID, 0),
bb_put(i_call_nth_counter, C).
%% countall(G_0, N).
%
% countall(G_0, N) is true iff N unifies with the total number of
% answers of call(G_0).
:- meta_predicate(countall(0, ?)).
countall(Goal, N) :-
can_be(integer, N),
( integer(N) ->
( N < 0 ->
domain_error(not_less_than_zero, N, countall/2)
; true
)
; true
),
setup_call_cleanup(call_nth_nesting(C, ID),
( ( Goal,
bb_get(ID, N0),
N1 is N0 + 1,
bb_put(ID, N1),
false
; bb_get(ID, N)
)
),
( bb_get(i_call_nth_counter, C) ->
C1 is C - 1,
bb_put(i_call_nth_counter, C1)
; true
)).
%% copy_term_nat(Source, Dest)
%
% Similar to `copy_term/2` but without attribute variables
copy_term_nat(Source, Dest) :-
'$copy_term_without_attr_vars'(Source, Dest).
%% asserta(Module, Rule_Fact).
%
% Similar to `asserta/1` but allows specifying a Module
asserta(Module, (Head :- Body)) :-
!,
'$asserta'(Module, Head, Body).
asserta(Module, Fact) :-
'$asserta'(Module, Fact, true).
%% assertz(Module, Rule_Fact).
%
% Similar to `assertz/1` but allows specifying a Module
assertz(Module, (Head :- Body)) :-
!,
'$assertz'(Module, Head, Body).

View File

@@ -50,11 +50,13 @@ programming based on call/N.
Lambda expressions are represented by ordinary Prolog terms.
There are two kinds of lambda expressions:
```
Free+\X1^X2^ ..^XN^Goal
\X1^X2^ ..^XN^Goal
```
The second is a shorthand for t+\X1^X2^..^XN^Goal.
The second is a shorthand for `t+\X1^X2^..^XN^Goal`.
Xi are the parameters.
@@ -70,20 +72,20 @@ currently not checked. Violations may lead to unexpected bindings.
In the following example the parentheses around X>3 are necessary.
==
```
?- use_module(library(lambda)).
?- use_module(library(lists)).
?- maplist(\X^(X>3),[4,5,9]).
true.
==
```
In the following X is a variable that is shared by both instances of
the lambda expression. The second query illustrates the cooperation of
continuations and lambdas. The lambda expression is in this case a
continuation expecting a further argument.
==
```
?- use_module(library(dif)).
true.
@@ -92,11 +94,12 @@ continuation expecting a further argument.
?- Xs = [A,B], maplist(X+\dif(X), Xs).
Xs = [A,B], dif:dif(X,A), dif:dif(X,B).
==
```
The following queries are all equivalent. To see this, use
the fact f(x,y).
==
the fact `f(x,y)`.
```
?- call(f,A1,A2).
?- call(\X^f(X),A1,A2).
?- call(\X^Y^f(X,Y), A1,A2).
@@ -105,10 +108,10 @@ the fact f(x,y).
?- call(f(A1),A2).
?- f(A1,A2).
A1 = x, A2 = y.
==
```
Further discussions
http://www.complang.tuwien.ac.at/ulrich/Prolog-inedit/ISO-Hiord
[http://www.complang.tuwien.ac.at/ulrich/Prolog-inedit/ISO-Hiord](http://www.complang.tuwien.ac.at/ulrich/Prolog-inedit/ISO-Hiord)
@tbd Static expansion similar to apply_macros.
@author Ulrich Neumerkel

View File

@@ -1,3 +1,7 @@
/**
List manipulation predicates
*/
:- 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,
@@ -57,6 +61,20 @@
resource_error(Resource, Context) :-
throw(error(resource_error(Resource), Context)).
%% length(?Xs, ?N).
%
% Relates a list to its length (number of elements). It can be used to count the elements of a current list or
% to create a list full of free variables with N length.
%
% ```
% ?- length("abc", 3).
% true.
% ?- length("abc", N).
% N = 3.
% ?- length(Xs, 3).
% Xs = [_A,_B,_C].
% ```
length(Xs0, N) :-
'$skip_max_list'(M, N, Xs0,Xs),
!,
@@ -74,7 +92,7 @@ length(_, N) :-
length_rundown(Xs, 0) :- !, Xs = [].
length_rundown(Vs, N) :-
\+ \+ '$project_atts':copy_term(Vs,Vs,[]), % unconstrained
'$unattributed_var'(Vs), % unconstrained
!,
'$det_length_rundown'(Vs, N).
length_rundown([_|Xs], N) :- % force unification
@@ -82,7 +100,7 @@ length_rundown([_|Xs], N) :- % force unification
length(Xs, N1). % maybe some new info on Xs
failingvarskip(Xs) :-
\+ \+ '$project_atts':copy_term(Xs,Xs,[]), % unconstrained
'$unattributed_var'(Xs), % unconstrained
!.
failingvarskip([_|Xs0]) :- % force unification
'$skip_max_list'(_, _, Xs0,Xs),
@@ -95,28 +113,71 @@ length_addendum([_|Xs], N, M) :-
M1 is M + 1,
length_addendum(Xs, N, M1).
%% member(?X, ?Xs).
%
% Succeeds when X unifies with an item of the list Xs, which can be at any position.
%
% ```
% ?- member(X, "hello world").
% X = h
% ; ... .
% ```
member(X, [X|_]).
member(X, [_|Xs]) :- member(X, Xs).
member(X, [L|Ls]) :-
member_(Ls, L, X).
member_(_, X, X).
member_([L|Ls], _, X) :-
member_(Ls, L, X).
%% select(X, Xs0, Xs1).
%
% Succeeds when the list Xs1 is the list Xs0 without the item X
%
% ```
% ?- select(c, "abcd", X).
% X = "abd"
% ; false.
% ```
select(X, [X|Xs], Xs).
select(X, [Y|Xs], [Y|Ys]) :- select(X, Xs, Ys).
%% append(+XsXs, ?Xs).
%
% Concatenates a list of lists
%
% ```
% ?- append([[1, 2], [3]], Xs).
% Xs = [1,2,3].
% ```
append([], []).
append([L0|Ls0], Ls) :-
append(L0, Rest, Ls),
append(Ls0, Rest).
%% append(Xs0, Xs1, Xs).
%
% List Xs is the concatenation of Xs0 and Xs1
%
% ```
% ?- append([1,2,3], [4,5,6], Xs).
% Xs = [1,2,3,4,5,6].
% ```
append([], R, R).
append([X|L], R, [X|S]) :- append(L, R, S).
%% memberchk(?X, +Xs).
%
% This predicate is similar to `member/2`, but it only provides a single answer
memberchk(X, Xs) :- member(X, Xs), !.
%% reverse(?Xs, ?Ys).
%
% Xs is the Ys list in reverse order
%
% ?- reverse([1,2,3], [3,2,1]).
% true.
%
reverse(Xs, Ys) :-
( nonvar(Xs) -> reverse(Xs, Ys, [], Xs)
; reverse(Ys, Xs, [], Ys)
@@ -126,81 +187,141 @@ reverse([], [], YsRev, YsRev).
reverse([_|Xs], [Y1|Ys], YsPreludeRev, Xss) :-
reverse(Xs, Ys, [Y1|YsPreludeRev], Xss).
%% maplist(+Predicate, ?Xs0).
%
% This is a metapredicate that applies predicate to each element of the list Xs0
%
% ```
% ?- maplist(write, [1,2,3]).
% 123 true.
% ```
maplist(_, []).
maplist(Cont1, [E1|E1s]) :-
call(Cont1, E1),
maplist(Cont1, E1s).
%% maplist(+Predicate, ?Xs0, ?Xs1).
%
% This is a metapredicate that applies predicate to each element of the lists Xs0 and Xs1.
%
% ```
% ?- maplist(length, ["hello", "prolog", "marseille"], Xs1).
% Xs1 = [5,6,9].
% ```
maplist(_, [], []).
maplist(Cont2, [E1|E1s], [E2|E2s]) :-
call(Cont2, E1, E2),
maplist(Cont2, E1s, E2s).
%% maplist(+Predicate, ?Xs0, ?Xs1, ?Xs2).
%
% This is a metapredicate that applies predicate to each element of the lists Xs0, Xs1 and Xs2.
maplist(_, [], [], []).
maplist(Cont3, [E1|E1s], [E2|E2s], [E3|E3s]) :-
call(Cont3, E1, E2, E3),
maplist(Cont3, E1s, E2s, E3s).
%% maplist(+Predicate, ?Xs0, ?Xs1, ?Xs2, ?Xs3).
%
% This is a metapredicate that applies predicate to each element of the lists Xs0, Xs1, Xs2 and Xs3.
maplist(_, [], [], [], []).
maplist(Cont, [E1|E1s], [E2|E2s], [E3|E3s], [E4|E4s]) :-
call(Cont, E1, E2, E3, E4),
maplist(Cont, E1s, E2s, E3s, E4s).
%% maplist(+Predicate, ?Xs0, ?Xs1, ?Xs2, ?Xs3, ?Xs4).
%
% This is a metapredicate that applies predicate to each element of the lists Xs0, Xs1, Xs2, Xs3 and Xs4.
maplist(_, [], [], [], [], []).
maplist(Cont, [E1|E1s], [E2|E2s], [E3|E3s], [E4|E4s], [E5|E5s]) :-
call(Cont, E1, E2, E3, E4, E5),
maplist(Cont, E1s, E2s, E3s, E4s, E5s).
%% maplist(+Predicate, ?Xs0, ?Xs1, ?Xs2, ?Xs3, ?Xs4, ?Xs5).
%
% This is a metapredicate that applies predicate to each element of the lists Xs0, Xs1, Xs2, Xs3, Xs4 and Xs5.
maplist(_, [], [], [], [], [], []).
maplist(Cont, [E1|E1s], [E2|E2s], [E3|E3s], [E4|E4s], [E5|E5s], [E6|E6s]) :-
call(Cont, E1, E2, E3, E4, E5, E6),
maplist(Cont, E1s, E2s, E3s, E4s, E5s, E6s).
%% maplist(+Predicate, ?Xs0, ?Xs1, ?Xs2, ?Xs3, ?Xs4, ?Xs5, ?Xs6).
%
% This is a metapredicate that applies predicate to each element of the lists Xs0, Xs1, Xs2, Xs3, Xs4, Xs5 and Xs6.
maplist(_, [], [], [], [], [], [], []).
maplist(Cont, [E1|E1s], [E2|E2s], [E3|E3s], [E4|E4s], [E5|E5s], [E6|E6s], [E7|E7s]) :-
call(Cont, E1, E2, E3, E4, E5, E6, E7),
maplist(Cont, E1s, E2s, E3s, E4s, E5s, E6s, E7s).
%% maplist(+Predicate, ?Xs0, ?Xs1, ?Xs2, ?Xs3, ?Xs4, ?Xs5, ?Xs6, ?Xs7).
%
% This is a metapredicate that applies predicate to each element of the lists Xs0, Xs1, Xs2, Xs3, Xs4, Xs5, Xs6 and Xs7.
maplist(_, [], [], [], [], [], [], [], []).
maplist(Cont, [E1|E1s], [E2|E2s], [E3|E3s], [E4|E4s], [E5|E5s], [E6|E6s], [E7|E7s], [E8|E8s]) :-
call(Cont, E1, E2, E3, E4, E5, E6, E7, E8),
maplist(Cont, E1s, E2s, E3s, E4s, E5s, E6s, E7s, E8s).
%% sum_list(+Xs, -Sum).
%
% Takes a lists of numbers and unifies Sum with the result of summing all the elements of the list.
%
% ```
% ?- sum_list([2,2,2], 6).
% true.
% ```
sum_list(Ls, S) :-
foldl(lists:sum_, Ls, 0, S).
sum_(L, S0, S) :- S is S0 + L.
%% same_length(?Xs, ?Ys).
%
% Succeeds if Xs and Ys are lists of the same length
same_length([], []).
same_length([_|As], [_|Bs]) :-
same_length(As, Bs).
%% foldl(+Predicate, ?Ls, +A0, ?A).
%
% foldl, sometimes called reduce, is a metapredicate that takes a predicate, a list of items
% and a starting value, and outputs a single value. The predicate _Predicate_ must be able to take the current
% element of the list, the previous value of the computation and the next value of the computation.
%
% For example, if we define sum_ as:
%
% ```
% sum_(L, S0, S) :- S is S0 + L.
% ```
%
% Then we can define `sum_list/2` as the following:
%
% ```
% sum_list(Ls, S) :- foldl(sum_, Ls, 0, S).
% ```
foldl(Goal_3, Ls, A0, A) :-
foldl_(Ls, Goal_3, A0, A).
foldl_([], _, A, A).
foldl_([L|Ls], G_3, A0, A) :-
foldl(_, [], A, A).
foldl(G_3, [L|Ls], A0, A) :-
call(G_3, L, A0, A1),
foldl_(Ls, G_3, A1, A).
foldl(G_3, Ls, A1, A).
%% foldl(+Predicate, ?Ls0, ?Ls1, +A0, ?A).
%
% Same as `foldl/4` but with an extra list
foldl(Goal_4, Xs, Ys, A0, A) :-
foldl_(Xs, Ys, Goal_4, A0, A).
foldl_([], [], _, A, A).
foldl_([X|Xs], [Y|Ys], G_4, A0, A) :-
foldl(_, [], [], A, A).
foldl(G_4, [X|Xs], [Y|Ys], A0, A) :-
call(G_4, X, Y, A0, A1),
foldl_(Xs, Ys, G_4, A1, A).
foldl(G_4, Xs, Ys, A1, A).
%% transpose(?Ls, ?Ts).
%
% If Ls is a list of lists, Ts contains the transposition
%
% ```
% ?- transpose([[1,1],[2,2]], Ts).
% Ts = [[1,2],[1,2]].
% ```
transpose(Ls, Ts) :-
lists_transpose(Ls, Ts).
@@ -214,7 +335,14 @@ transpose_(_, Fs, Lists0, Lists) :-
list_first_rest([L|Ls], L, Ls).
%% list_to_set(+Ls0, -Set).
%
% Takes a list Ls0 and returns a list Set that doesn't contain any repeated element
%
% ```
% ?- list_to_set([2,3,4,4,1,2], Set).
% Set = [2,3,4,1].
% ```
list_to_set(Ls0, Ls) :-
maplist(lists:with_var, Ls0, LVs0),
keysort(LVs0, LVs),
@@ -242,7 +370,14 @@ unify_same(E-V, Prev-Var, E-V) :-
; true
).
%% nth0(?N, ?Ls, ?E).
%
% Succeeds if in the N position of the list Ls, we found the element E. The elements start counting from zero.
%
% ```
% ?- nth0(2, [1,2,3,4], 3).
% true.
% ```
nth0(N, Es0, E) :-
nonvar(N),
'$skip_max_list'(Skip, N, Es0,Es1),
@@ -261,7 +396,6 @@ nth0(N, Es0, E) :-
skipn(N0, Es0,Es) :-
N0>0,
!, % should not be necessary #1028
N1 is N0-1,
Es0 = [_|Es1],
skipn(N1, Es1,Es).
@@ -277,6 +411,14 @@ nth0_el(N0,N, _,E, [E0|Es0]) :-
N1 is N0+1,
nth0_el(N1,N, E0,E, Es0).
%% nth1(?N, ?Ls, ?E).
%
% Succeeds if in the N position of the list Ls, we found the element E. The elements start counting from one.
%
% ```
% ?- nth1(2, [1,2,3,4], 2).
% true.
% ```
nth1(N, Es0, E) :-
N \== 0,
nth0(N, [_|Es0], E),
@@ -284,13 +426,20 @@ nth1(N, Es0, E) :-
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, ?Ls, ?E, ?Rs).
%
% Succeeds if in the N position of the list Ls, we found the element E and the rest of the list is Rs. The elements start counting from zero.
%
% ```
% ?- nth0(2, [1,2,3,4], 3, [1,2,4]).
% true.
% ```
nth0(N, Es0, E, Es) :-
integer(N),
N >= 0,
@@ -315,45 +464,58 @@ nth0_elx(N0,N, E0,E, [E1|Es0], [E0|Es]) :-
% p.p.8.5
%% nth1(?N, ?Ls, ?E, ?Rs).
%
% Succeeds if in the N position of the list Ls, we found the element E and the rest of the list is Rs. The elements start counting from one.
%
% ```
% ?- nth1(2, [1,2,3,4], 2, [1,3,4]).
% true.
% ```
nth1(N, Es0, E, Es) :-
N \== 0,
nth0(N, [_|Es0], E, [_|Es]),
N \== 0.
%% list_max(+Xs, -Max).
%
% Takes a list Xs and unifies with the maximum value of the list
list_max([N|Ns], Max) :-
foldl(lists:list_max_, Ns, N, Max).
list_max_(N, Max0, Max) :-
Max is max(N, Max0).
%% list_min(+Xs, -Min).
%
% Takes a list Xs and unifies with the minimum value of the list
list_min([N|Ns], Min) :-
foldl(lists:list_min_, Ns, N, Min).
list_min_(N, Min0, Min) :-
Min is min(N, Min0).
%! permutation(?Xs, ?Ys) is nondet.
%% permutation(?Xs, ?Ys) is nondet.
%
% True when Xs is a permutation of Ys. This can solve for Ys given
% Xs or Xs given Ys, or even enumerate Xs and Ys together. The
% predicate permutation/2 is primarily intended to generate
% permutations. Note that a list of length N has N! permutations,
% and unbounded permutation generation becomes prohibitively
% expensive, even for rather short lists (10! = 3,628,800).
% True when Xs is a permutation of Ys. This can solve for Ys given
% Xs or Xs given Ys, or even enumerate Xs and Ys together. The
% predicate `permutation/2` is primarily intended to generate
% permutations. Note that a list of length N has N! permutations,
% and unbounded permutation generation becomes prohibitively
% expensive, even for rather short lists (10! = 3,628,800).
%
% The example below illustrates that Xs and Ys being proper lists
% is not a sufficient condition to use the above replacement.
% The example below illustrates that Xs and Ys being proper lists
% is not a sufficient condition to use the above replacement.
%
% ==
% ?- permutation([1,2], [X,Y]).
% X = 1, Y = 2 ;
% X = 2, Y = 1 ;
% false.
% ==
% ```
% ?- permutation([1,2], [X,Y]).
% X = 1, Y = 2
% ; X = 2, Y = 1
% ; false.
% ```
%
% @error type_error(list, Arg) if either argument is not a proper
% or partial list.
% Throws `type_error(list, Arg)` if either argument is not a proper
% or partial list.
permutation(Xs, Ys) :-
'$skip_max_list'(Xlen, _, Xs, XTail),

View File

@@ -54,39 +54,38 @@
:- use_module(library(lists)).
/** <module> Ordered set manipulation
/** Ordered set manipulation
Ordered sets are lists with unique elements sorted to the standard order
of terms (see sort/2). Exploiting ordering, many of the set operations
of terms (see `sort/2`). Exploiting ordering, many of the set operations
can be expressed in order N rather than N^2 when dealing with unordered
sets that may contain duplicates. The library(ordsets) is available in a
number of Prolog implementations. Our predicates are designed to be
compatible with common practice in the Prolog community. The
implementation is incomplete and relies partly on library(oset), an
older ordered set library distributed with SWI-Prolog. New applications
are advised to use library(ordsets).
compatible with common practice in the Prolog community.
Some of these predicates match directly to corresponding list
operations. It is advised to use the versions from this library to make
clear you are operating on ordered sets. An exception is member/2. See
ord_memberchk/2.
clear you are operating on ordered sets. An exception is `member/2`. See
`ord_memberchk/2`.
The ordsets library is based on the standard order of terms. This
implies it can handle all Prolog terms, including variables. Note
however, that the ordering is not stable if a term inside the set is
further instantiated. Also note that variable ordering changes if
variables in the set are unified with each other or a variable in the
set is unified with a variable that is `older' than the newest variable
set is unified with a variable that is _older_ than the newest variable
in the set. In practice, this implies that it is allowed to use
member(X, OrdSet) on an ordered set that holds variables only if X is a
fresh variable. In other cases one should cease using it as an ordset
because the order it relies on may have been changed.
*/
%! is_ordset(@Term) is semidet.
%% is_ordset(@Term) is semidet.
%
% True if Term is an ordered set. All predicates in this library
% expect ordered sets as input arguments. Failing to fullfil this
% assumption results in undefined behaviour. Typically, ordered
% sets are created by predicates from this library, sort/2 or
% setof/3.
% True if Term is an ordered set. All predicates in this library
% expect ordered sets as input arguments. Failing to fullfil this
% assumption results in undefined behaviour. Typically, ordered
% sets are created by predicates from this library, `sort/2` or
% `setof/3`.
is_ordset(Term) :-
'$skip_max_list'(_, _, Term, Tail), Tail == [], %% is_list(Term),
@@ -102,37 +101,35 @@ is_ordset3([H2|T], H) :-
is_ordset3(T, H2).
%! ord_empty(?List) is semidet.
%% ord_empty(?List) is semidet.
%
% True when List is the empty ordered set. Simply unifies list
% with the empty list. Not part of Quintus.
% True when List is the empty ordered set. Simply unifies list
% with the empty list. Not part of Quintus.
ord_empty([]).
%! ord_seteq(+Set1, +Set2) is semidet.
%% ord_seteq(+Set1, +Set2) is semidet.
%
% True if Set1 and Set2 have the same elements. As both are
% canonical sorted lists, this is the same as ==/2.
%
% @compat sicstus
% True if Set1 and Set2 have the same elements. As both are
% canonical sorted lists, this is the same as `==/2`.
ord_seteq(Set1, Set2) :-
Set1 == Set2.
%! list_to_ord_set(+List, -OrdSet) is det.
%% list_to_ord_set(+List, -OrdSet) is det.
%
% Transform a list into an ordered set. This is the same as
% sorting the list.
% Transform a list into an ordered set. This is the same as
% sorting the list.
list_to_ord_set(List, Set) :-
sort(List, Set).
%! ord_intersect(+Set1, +Set2) is semidet.
%% ord_intersect(+Set1, +Set2) is semidet.
%
% True if both ordered sets have a non-empty intersection.
% True if both ordered sets have a non-empty intersection.
ord_intersect([H1|T1], L2) :-
ord_intersect_(L2, H1, T1).
@@ -148,31 +145,29 @@ ord_intersect__(>, H1, T1, _H2, T2) :-
ord_intersect_(T2, H1, T1).
%! ord_disjoint(+Set1, +Set2) is semidet.
%% ord_disjoint(+Set1, +Set2) is semidet.
%
% True if Set1 and Set2 have no common elements. This is the
% negation of ord_intersect/2.
% True if Set1 and Set2 have no common elements. This is the
% negation of `ord_intersect/2`.
ord_disjoint(Set1, Set2) :-
\+ ord_intersect(Set1, Set2).
%! ord_intersect(+Set1, +Set2, -Intersection)
%% ord_intersect(+Set1, +Set2, -Intersection)
%
% Intersection holds the common elements of Set1 and Set2.
% Intersection holds the common elements of Set1 and Set2.
%
% @deprecated Use ord_intersection/3
% This predicate is *deprecated*. Use `ord_intersection/3`
ord_intersect(Set1, Set2, Intersection) :-
oset_int(Set1, Set2, Intersection).
%! ord_intersection(+PowerSet, -Intersection)
%% ord_intersection(+PowerSet, -Intersection)
%
% Intersection of a powerset. True when Intersection is an ordered
% set holding all elements common to all sets in PowerSet.
%
% @compat sicstus
% Intersection of a powerset. True when Intersection is an ordered
% set holding all elements common to all sets in PowerSet.
ord_intersection(PowerSet, Intersection) :-
key_by_length(PowerSet, Pairs),
@@ -190,10 +185,10 @@ l_int([_-H|T], S0, S) :-
l_int(T, S1, S).
%! ord_intersection(+Set1, +Set2, -Intersection) is det.
%% ord_intersection(+Set1, +Set2, -Intersection) is det.
%
% Intersection holds the common elements of Set1 and Set2. Uses
% ord_disjoint/2 if Intersection is bound to `[]` on entry.
% Intersection holds the common elements of Set1 and Set2. Uses
% `ord_disjoint/2` if Intersection is bound to `[]` on entry.
ord_intersection(Set1, Set2, Intersection) :-
( Intersection == []
@@ -202,13 +197,11 @@ ord_intersection(Set1, Set2, Intersection) :-
).
%! ord_intersection(+Set1, +Set2, ?Intersection, ?Difference) is det.
%% ord_intersection(+Set1, +Set2, ?Intersection, ?Difference) is det.
%
% Intersection and difference between two ordered sets.
% Intersection is the intersection between Set1 and Set2, while
% Difference is defined by ord_subtract(Set2, Set1, Difference).
%
% @see ord_intersection/3 and ord_subtract/3.
% Intersection and difference between two ordered sets.
% Intersection is the intersection between Set1 and Set2, while
% Difference is defined by `ord_subtract(Set2, Set1, Difference)`.
ord_intersection([], L, [], L) :- !.
ord_intersection([_|_], [], [], []) :- !.
@@ -224,35 +217,35 @@ ord_intersection2(>, H1, T1, H2, T2, Intersection, [H2|HDiff]) :-
ord_intersection([H1|T1], T2, Intersection, HDiff).
%! ord_add_element(+Set1, +Element, ?Set2) is det.
%% ord_add_element(+Set1, +Element, ?Set2) is det.
%
% Insert an element into the set. This is the same as
% ord_union(Set1, [Element], Set2).
% Insert an element into the set. This is the same as
% `ord_union(Set1, [Element], Set2)`.
ord_add_element(Set1, Element, Set2) :-
oset_addel(Set1, Element, Set2).
%! ord_del_element(+Set, +Element, -NewSet) is det.
%% ord_del_element(+Set, +Element, -NewSet) is det.
%
% Delete an element from an ordered set. This is the same as
% ord_subtract(Set, [Element], NewSet).
% Delete an element from an ordered set. This is the same as
% `ord_subtract(Set, [Element], NewSet)`.
ord_del_element(Set, Element, NewSet) :-
oset_delel(Set, Element, NewSet).
%! ord_selectchk(+Item, ?Set1, ?Set2) is semidet.
%% ord_selectchk(+Item, ?Set1, ?Set2) is semidet.
%
% Selectchk/3, specialised for ordered sets. Is true when
% select(Item, Set1, Set2) and Set1, Set2 are both sorted lists
% without duplicates. This implementation is only expected to work
% for Item ground and either Set1 or Set2 ground. The "chk" suffix
% is meant to remind you of memberchk/2, which also expects its
% first argument to be ground. ord_selectchk(X, S, T) =>
% ord_memberchk(X, S) & \+ ord_memberchk(X, T).
% `selectchk/3`, specialised for ordered sets. Is true when
% select(Item, Set1, Set2) and Set1, Set2 are both sorted lists
% without duplicates. This implementation is only expected to work
% for Item ground and either Set1 or Set2 ground. The "chk" suffix
% is meant to remind you of `memberchk/2`, which also expects its
% first argument to be ground. `ord_selectchk(X, S, T) =>
% ord_memberchk(X, S) & \+ ord_memberchk(X, T).`
%
% @author Richard O'Keefe
% Author: Richard O'Keefe
ord_selectchk(Item, [X|Set1], [X|Set2]) :-
X @< Item,
@@ -266,19 +259,19 @@ ord_selectchk(Item, [Item|Set1], Set1) :-
).
%! ord_memberchk(+Element, +OrdSet) is semidet.
%% ord_memberchk(+Element, +OrdSet) is semidet.
%
% True if Element is a member of OrdSet, compared using ==. Note
% that _enumerating_ elements of an ordered set can be done using
% member/2.
% True if Element is a member of OrdSet, compared using ==. Note
% that _enumerating_ elements of an ordered set can be done using
% `member/2`.
%
% Some Prolog implementations also provide ord_member/2, with the
% same semantics as ord_memberchk/2. We believe that having a
% semidet ord_member/2 is unacceptably inconsistent with the *_chk
% convention. Portable code should use ord_memberchk/2 or
% member/2.
% Some Prolog implementations also provide `ord_member/2`, with the
% same semantics as `ord_memberchk/2`. We believe that having a
% semidet `ord_member/2` is unacceptably inconsistent with the \*\_chk
% convention. Portable code should use `ord_memberchk/2` or
% `member/2`.
%
% @author Richard O'Keefe
% Author: Richard O'Keefe
ord_memberchk(Item, [X1,X2,X3,X4|Xs]) :-
!,
@@ -303,9 +296,9 @@ ord_memberchk(Item, [X1]) :-
Item == X1.
%! ord_subset(+Sub, +Super) is semidet.
%% ord_subset(+Sub, +Super) is semidet.
%
% Is true if all elements of Sub are in Super
% Is true if all elements of Sub are in Super
ord_subset([], _).
ord_subset([H1|T1], [H2|T2]) :-
@@ -319,22 +312,20 @@ ord_subset_(=, _, T1, T2) :-
ord_subset(T1, T2).
%! ord_subtract(+InOSet, +NotInOSet, -Diff) is det.
%% ord_subtract(+InOSet, +NotInOSet, -Diff) is det.
%
% Diff is the set holding all elements of InOSet that are not in
% NotInOSet.
% Diff is the set holding all elements of InOSet that are not in
% NotInOSet.
ord_subtract(InOSet, NotInOSet, Diff) :-
oset_diff(InOSet, NotInOSet, Diff).
%! ord_union(+SetOfSets, -Union) is det.
%% ord_union(+SetOfSets, -Union) is det.
%
% True if Union is the union of all elements in the superset
% SetOfSets. Each member of SetOfSets must be an ordered set, the
% sets need not be ordered in any way.
%
% @author Copied from YAP, probably originally by Richard O'Keefe.
% True if Union is the union of all elements in the superset
% SetOfSets. Each member of SetOfSets must be an ordered set, the
% sets need not be ordered in any way.
ord_union([], []).
ord_union([Set|Sets], Union) :-
@@ -355,18 +346,18 @@ ord_union_all(N, Sets0, Union, Sets) :-
).
%! ord_union(+Set1, +Set2, ?Union) is det.
%% ord_union(+Set1, +Set2, ?Union) is det.
%
% Union is the union of Set1 and Set2
% Union is the union of Set1 and Set2
ord_union(Set1, Set2, Union) :-
oset_union(Set1, Set2, Union).
%! ord_union(+Set1, +Set2, -Union, -New) is det.
%% ord_union(+Set1, +Set2, -Union, -New) is det.
%
% True iff ord_union(Set1, Set2, Union) and
% ord_subtract(Set2, Set1, New).
% True iff `ord_union(Set1, Set2, Union)` and
% `ord_subtract(Set2, Set1, New)`.
ord_union([], Set2, Set2, Set2).
ord_union([H|T], Set2, Union, New) :-
@@ -390,26 +381,26 @@ ord_union_2([H|T], H2, T2, Union, New) :-
ord_union(Order, H, T, H2, T2, Union, New).
%! ord_symdiff(+Set1, +Set2, ?Difference) is det.
%% ord_symdiff(+Set1, +Set2, ?Difference) is det.
%
% Is true when Difference is the symmetric difference of Set1 and
% Set2. I.e., Difference contains all elements that are not in the
% intersection of Set1 and Set2. The semantics is the same as the
% sequence below (but the actual implementation requires only a
% single scan).
% Is true when Difference is the symmetric difference of Set1 and
% Set2. I.e., Difference contains all elements that are not in the
% intersection of Set1 and Set2. The semantics is the same as the
% sequence below (but the actual implementation requires only a
% single scan).
%
% ==
% ord_union(Set1, Set2, Union),
% ord_intersection(Set1, Set2, Intersection),
% ord_subtract(Union, Intersection, Difference).
% ==
% ```
% ord_union(Set1, Set2, Union),
% ord_intersection(Set1, Set2, Intersection),
% ord_subtract(Union, Intersection, Difference).
% ```
%
% For example:
% For example:
%
% ==
% ?- ord_symdiff([1,2], [2,3], X).
% X = [1,3].
% ==
% ```
% ?- ord_symdiff([1,2], [2,3], X).
% X = [1,3].
% ```
ord_symdiff([], Set2, Set2).
ord_symdiff([H1|T1], Set2, Difference) :-
@@ -457,7 +448,7 @@ ord_symdiff(>, H1, T1, H2, Set2, [H2|Difference]) :-
*/
/** <module> Ordered set manipulation
/* Ordered set manipulation
This library defines set operations on sets represented as ordered
lists.

View File

@@ -12,6 +12,12 @@
Public domain code.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/** Predicates for reasoning about the operating system (OS) environment.
This includes predicates about environment variables, calls to shell and
finding out the PID of the running system.
*/
:- module(os, [getenv/2,
setenv/2,
unsetenv/1,
@@ -24,25 +30,60 @@
:- use_module(library(lists)).
:- use_module(library(si)).
%% getenv(+Key, -Value).
%
% True iff Value contains the value of the environment variable Key.
% Example:
%
% ```
% ?- getenv("LANG", Ls).
% Ls = "en_US.UTF-8".
% ```
getenv(Key, Value) :-
must_be_env_var(Key),
'$getenv'(Key, Value).
%% setenv(+Key, +Value).
%
% Sets the environment variable Key to Value
setenv(Key, Value) :-
must_be_env_var(Key),
must_be_chars(Value),
'$setenv'(Key, Value).
%% unsetenv(+Key).
%
% Unsets the environment variable Key
unsetenv(Key) :-
must_be_env_var(Key),
'$unsetenv'(Key).
%% shell(+Command)
%
% Equivalent to `shell(Command, 0)`.
shell(Command) :- shell(Command, 0).
%% shell(+Command, -Status).
%
% True iff executes Command in a shell of the operating system and the exit code is Status.
% Keep in mind the shell syntax is dependant on the operating system, so it should be
% used very carefully.
%
% Example (using Linux and fish shell):
%
% ```
% ?- shell("echo $SHELL", Status).
% /bin/fish
% Status = 0.
% ```
shell(Command, Status) :-
must_be_chars(Command),
can_be(integer, Status),
'$shell'(Command, Status).
%% pid(-PID).
%
% True iff PID is the process identification number of current Scryer Prolog instance.
pid(PID) :-
can_be(integer, PID),
'$pid'(PID).

View File

@@ -1,3 +1,10 @@
/** Reasoning about pairs.
Pairs are Prolog terms with principal functor `(-)/2`. A pair
often has the form `Key-Value`. The predicates of this library
relate pairs to keys and values.
*/
:- module(pairs, [pairs_keys_values/3,
pairs_keys/2,
pairs_values/2,
@@ -7,12 +14,25 @@
:- meta_predicate map_list_to_pairs(2, ?, ?).
%% pairs_keys_values(?Pairs, ?Keys, ?Values)
%
% The first argument is a list of Pairs, the second the corresponding
% Keys, and the third argument the corresponding values.
pairs_keys_values([], [], []).
pairs_keys_values([A-B|ABs], [A|As], [B|Bs]) :-
pairs_keys_values(ABs, As, Bs).
%% pairs_keys(?Pairs, ?Keys)
%
% Same as `pairs_keys_values(Pairs, Keys, _)`.
pairs_keys(Ps, Ks) :- pairs_keys_values(Ps, Ks, _).
%% pairs_values(?Pairs, ?Values)
%
% Same as `pairs_keys_values(Pairs, _, Values)`.
pairs_values(Ps, Vs) :- pairs_keys_values(Ps, _, Vs).
map_list_to_pairs(Pred, Ls, Ps) :-

View File

@@ -1,16 +1,15 @@
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Pure I/O
========
/** Pure I/O.
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,3] and phrase_to_stream/2 let us apply DCGs
for describing strings. The predicates `phrase_from_file/[2,3]`,
`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,
phrase_from_file/3,
phrase_from_stream/2,
phrase_to_file/2,
phrase_to_file/3,
phrase_to_stream/2
@@ -19,26 +18,42 @@
:- use_module(library(dcgs)).
:- use_module(library(error)).
:- use_module(library(freeze)).
:- use_module(library(iso_ext), [setup_call_cleanup/3, partial_string/3]).
:- use_module(library(lists), [member/2, maplist/2]).
:- use_module(library(gensym)).
:- use_module(library(iso_ext), [
bb_get/2, bb_put/2, setup_call_cleanup/3, partial_string/3, partial_string_tail/2
]).
:- use_module(library(lists), [append/3, length/2, member/2, maplist/2]).
:- use_module(library(charsio), [get_n_chars/3]).
:- meta_predicate(phrase_from_file(2, ?)).
:- meta_predicate(phrase_from_file(2, ?, ?)).
:- meta_predicate(phrase_from_stream(2, ?)).
:- meta_predicate(phrase_to_file(2, ?)).
:- meta_predicate(phrase_to_file(2, ?, ?)).
:- meta_predicate(phrase_to_stream(2, ?)).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
phrase_from_file(GRBody, File)
True if grammar rule body GRBody covers the contents of File,
represented as a list of characters.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
%% phrase_from_stream(+GRBody, +Stream)
%
% True if grammar rule body GRBody covers the contents of the stream,
% represented as a list of characters.
phrase_from_stream(GRBody, Stream) :-
stream_to_lazy_list(Stream, Ls),
phrase(GRBody, Ls).
%% phrase_from_file(+GRBody, +File)
%
% True if grammar rule body GRBody covers the contents of File,
% represented as a list of characters.
phrase_from_file(NT, File) :-
phrase_from_file(NT, File, []).
%% phrase_from_file(+GRBody, +File, +Options)
%
% Like `phrase_from_file/2`, using Options to open the file.
phrase_from_file(NT, File, Options) :-
( var(File) -> instantiation_error(phrase_from_file/3)
; must_be(list, Options),
@@ -48,43 +63,138 @@ phrase_from_file(NT, File, Options) :-
member(Type, [text,binary])
; Type = text
),
setup_call_cleanup(open(File, read, Stream, [reposition(true)|Options]),
( stream_to_lazy_list(Stream, Xs),
phrase(NT, Xs) ),
close(Stream))
).
setup_call_cleanup(
open(File, read, Stream, Options),
phrase_from_stream(NT, Stream),
close(Stream)
)
).
% How many chars to read from stream and buffer in each step
chars_to_read(4096).
stream_to_lazy_list(Stream, Xs) :-
stream_property(Stream, position(Pos)),
freeze(Xs, reader_step(Stream, Pos, Xs)).
stream_to_lazy_list(Stream, Ls) :-
get_stream_buffer_position(Stream, Pos),
freeze(Ls, render_step(Stream, Pos, Ls)).
reader_step(Stream, Pos, Xs0) :-
set_stream_position(Stream, Pos),
( at_end_of_stream(Stream)
-> Xs0 = []
; get_n_chars(Stream, 4096, Cs),
partial_string(Cs, Xs0, Xs),
stream_to_lazy_list(Stream, Xs)
).
render_step(Stream, Pos, Ls) :-
set_stream_buffer_position(Stream, Pos),
( buffer_at_end_of_stream(Stream) ->
Ls = []
; chars_to_read(CharsToRead),
buffer_get_n_chars(Stream, CharsToRead, Chars),
partial_string(Chars, Ls, Ls0),
stream_to_lazy_list(Stream, Ls0)
).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
phrase_to_stream(+GRBody, +Stream)
buffer_at_end_of_stream(Stream) :-
stream_bufferids(Stream, _, BufferPosId, _),
bb_get(BufferPosId, Pos),
Pos = eof.
Emit the list of characters described by the grammar rule body
GRBody to Stream.
get_stream_buffer_position(Stream, Pos) :-
stream_bufferids(Stream, _, BufferPosId, _),
bb_get(BufferPosId, Pos).
An ideal implementation of phrase_to_stream/2 writes each character
as soon as it becomes known and no choice-points remain, and thus
avoids the manifestation of the entire string in memory. See #691
for more information.
set_stream_buffer_position(Stream, Pos) :-
stream_bufferids(Stream, _, BufferPosId, _),
bb_put(BufferPosId, Pos).
The current preliminary implementation is provided so that Prolog
programmers can already get used to describing output with DCGs,
and then writing it to a file when necessary. This simple
implementation suffices as long as the entire contents can be
represented in memory, and thus covers a large number of use cases.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
buffer_get_n_chars(Stream, N, Chars) :-
stream_bufferids(Stream, BufferId, BufferPosId, BufferLenId),
buffer_prepare_for_n(Stream, BufferId, BufferPosId, BufferLenId, N),
bb_get(BufferId, Buffer),
bb_get(BufferPosId, BufferPos),
( BufferPos = eof ->
Chars = []
; string_get_n_chars(Buffer, BufferPos, N, Chars),
length(Chars, NChars),
( NChars = 0 ->
BufferPos1 = eof
; BufferPos1 is BufferPos + NChars
),
bb_put(BufferPosId, BufferPos1)
).
buffer_prepare_for_n(Stream, BufferId, BufferPosId, BufferLenId, N) :-
bb_get(BufferPosId, BufferPos),
bb_get(BufferLenId, BufferLen),
( BufferLen < BufferPos + N ->
bb_get(BufferId, Buffer),
(
( var(Buffer) ->
BufferTail = Buffer
; partial_string_last_tail(Buffer, BufferTail)
) ->
( at_end_of_stream(Stream) ->
BufferTail = [],
bb_put(BufferId, Buffer)
; chars_to_read(CharsToRead),
get_n_chars(Stream, CharsToRead, Chars),
length(Chars, NChars),
partial_string(Chars, BufferTail, _),
bb_put(BufferId, Buffer),
BufferLen1 is BufferLen + NChars,
bb_put(BufferLenId, BufferLen1),
buffer_prepare_for_n(Stream, BufferId, BufferPosId, BufferLenId, N)
)
; true
)
; true
).
partial_string_last_tail(PartialString, PartialStringTail) :-
partial_string_tail(PartialString, PartialStringTail0),
( var(PartialStringTail0) ->
PartialStringTail = PartialStringTail0
; partial_string_last_tail(PartialStringTail0, PartialStringTail)
).
string_get_n_chars(String, Pos, N, Chars) :-
'$skip_max_list'(_, Pos, String, String1),
'$skip_max_list'(N1, N, String1, _),
length(Chars, N1),
append(Chars, _, String1).
stream_bufferids(Stream, BufferId, BufferPosId, BufferLenId) :-
( bb_get(streams_buffers, _) ->
true
; bb_put(streams_buffers, [])
),
bb_get(streams_buffers, StreamsBuffers),
( member(
stream_buffer(Stream, BufferId, BufferPosId, BufferLenId),
StreamsBuffers
) ->
true
; gensym(buffer, BufferId),
gensym(buffer_pos, BufferPosId),
gensym(buffer_len, BufferLenId),
bb_put(
streams_buffers,
[stream_buffer(Stream, BufferId, BufferPosId, BufferLenId)|StreamsBuffers]
),
bb_put(BufferId, _),
bb_put(BufferPosId, 0),
bb_put(BufferLenId, 0)
).
%% phrase_to_stream(+GRBody, +Stream)
%
% Emit the list of characters described by the grammar rule body
% GRBody to Stream.
%
% An ideal implementation of `phrase_to_stream/2` writes each
% character as soon as it becomes known and no choice-points remain,
% and thus avoids the manifestation of the entire string in memory.
% See [#691](https://github.com/mthom/scryer-prolog/issues/691) for
% more information.
%
% The current preliminary implementation is provided so that Prolog
% programmers can already get used to describing output with DCGs,
% and then writing it to a file when necessary. This simple
% implementation suffices as long as the entire contents can be
% represented in memory, and thus covers a large number of use cases.
phrase_to_stream(GRBody, Stream) :-
phrase(GRBody, Cs),
@@ -101,14 +211,18 @@ phrase_to_stream(GRBody, Stream) :-
% maplist(put_char(Stream), Cs). It also works for binary streams.
'$put_chars'(Stream, Cs).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
phrase_to_file(+GRBody, +File), writing the string described
by GRBody to File.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
%% phrase_to_file(+GRBody, +File)
%
% Write the string described by GRBody to File.
phrase_to_file(GRBody, File) :-
phrase_to_file(GRBody, File, []).
%% phrase_to_file(+GRBody, +File, +Options)
%
% Like `phrase_to_file/2`, using Options to open the file.
phrase_to_file(GRBody, File, Options) :-
setup_call_cleanup(open(File, write, Stream, Options),
phrase_to_stream(GRBody, Stream),

View File

@@ -1,24 +1,38 @@
:- module(random, [maybe/0, random/1, random_integer/3, set_random/1]).
/**
This library provides probabilistic predicates and random number generators.
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
To retain desirable declarative properties, predicates that internally
use random numbers should be equipped with an argument that specifies
the random seed. This makes everything completely reproducible.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
To retain desirable declarative properties, predicates that internally
use random numbers should be equipped with an argument that specifies
the random seed. This makes everything completely reproducible.
*/
:- module(random, [maybe/0, random/1, random_integer/3, set_random/1]).
:- use_module(library(error)).
% succeeds with probability 0.5.
%% maybe.
%
% Succeeds with probability 0.5.
maybe :- '$maybe'.
% The higher the precision, the slower it gets.
random_number_precision(64).
%% random(-R).
%
% Generates a random floating number between 0 (inclusive) and 1 (exclusive).
random(R) :-
var(R),
random_number_precision(N),
rnd(N, R).
%% random_integer(+Lower, +Upper, -R).
%
% Generates a random integer number between Lower (inclusive) and Upper (exclusive).
%
% Throws `instantiation_error` if Lower or Upper are variables.
%
% Throws `type_error` if Lower or Upper aren't integers.
random_integer(Lower, Upper, R) :-
var(R),
( (var(Lower) ; var(Upper)) ->
@@ -46,6 +60,10 @@ rnd_(N, R0, R) :-
R1 is R0 + 1.0 / 2.0 ^ N,
rnd_(N1, R1, R).
%% set_random(+Seed).
%
% Sets a seed that will be used for subsequent random generations in this library.
% It's necessary to set a seed to provide reproducible executions using this library.
set_random(Seed) :-
( nonvar(Seed) ->
( Seed = seed(S) ->

View File

@@ -1,3 +1,16 @@
/** Predicates from [*Indexing dif/2*](https://arxiv.org/abs/1607.01590).
Example:
```
?- tfilter(=(a), [X,Y], Es).
X = a, Y = a, Es = "aa"
; X = a, Es = "a", dif:dif(a,Y)
; Y = a, Es = "a", dif:dif(a,X)
; Es = [], dif:dif(a,X), dif:dif(a,Y).
```
*/
:- module(reif, [if_/3, (=)/3, (',')/3, (;)/3, cond_t/3, dif/3,
memberd_t/3, tfilter/3, tmember/2, tmember_t/3,
tpartition/4]).

View File

@@ -2,57 +2,70 @@
Predicates for parsing HTML and XML documents.
Written 2020-2022 by Markus Triska (triska@metalevel.at)
Part of Scryer Prolog.
Currently, two predicates are provided:
- load_html(+Source, -Es, +Options)
- load_xml(+Source, -Es, +Options)
These predicates parse HTML and XML documents, respectively.
Source must be one of:
- a list of characters with the document contents
- stream(S), specifying a stream S from which to read the content
- file(Name), where Name is a list of characters specifying a file name.
Es is unified with the abstract syntax tree of the parsed document,
represented as a list of elements where each is of the form:
* a list of characters, representing text
* element(Name, Attrs, Children)
- Name, an atom, is the name of the tag
- Attrs is a list of Key=Value pairs:
Key is an atom, and Value is a list of characters
- Children is a list of elements as specified here.
Currently, Options are ignored. In the future, more options may be
provided to control parsing.
Example:
?- load_html("<html><head><title>Hello!</title></head></html>", Es, []).
Yielding:
Es = [element(html,[],
[element(head,[],
[element(title,[],
["Hello!"])]),
element(body,[],[])])].
library(xpath) provides convenient reasoning about parsed documents.
For example, to fetch the title of the document above, we can use:
?- load_html("<html><head><title>Hello!</title></head></html>", Es, []),
xpath(Es, //title(text), T).
Yielding T = "Hello!".
Use http_open/3 from library(http/http_open) to read answers from
web servers via streams.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/** Predicates for parsing HTML and XML documents.
Currently, two predicates are provided:
- `load_html(+Source, -Es, +Options)`
- `load_xml(+Source, -Es, +Options)`
These predicates parse HTML and XML documents, respectively.
Source must be one of:
- a list of characters with the document contents
- `stream(S)`, specifying a stream S from which to read the content
- `file(Name)`, where Name is a list of characters specifying a file name.
Es is unified with the abstract syntax tree of the parsed document,
represented as a list of elements where each is of the form:
* a list of characters, representing text
* `element(Name, Attrs, Children)`
- `Name`, an atom, is the name of the tag
- `Attrs` is a list of `Key=Value` pairs:
`Key` is an atom, and `Value` is a list of characters
- `Children` is a list of elements as specified here.
Currently, Options are ignored. In the future, more options may be
provided to control parsing.
Example:
```
?- load_html("<html><head><title>Hello!</title></head></html>", Es, []).
```
Yielding:
```
Es = [element(html,[],
[element(head,[],
[element(title,[],
["Hello!"])]),
element(body,[],[])])].
```
`library(xpath)` provides convenient reasoning about parsed documents.
For example, to fetch the title of the document above, we can use:
```
?- load_html("<html><head><title>Hello!</title></head></html>", Es, []),
xpath(Es, //title(text), T).
```
Yielding `T = "Hello!"`.
Use `http_open/3` from `library(http/http_open)` to read answers from
web servers via streams.
*/
:- module(sgml, [load_html/3,
load_xml/3]).

View File

@@ -1,34 +1,44 @@
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Safe type tests
===============
/** Safe type tests.
"si" stands for "sufficiently instantiated".
"si" stands for "sufficiently instantiated". It can also be read as
"safe inference", so possibly also other predicates are candidates
for this library.
These predicates:
A safe type test:
- throw instantiation errors if the argument is
- throws an *instantiation error* if the argument is
not sufficiently instantiated to make a sound decision
- succeed if the argument is of the specified type
- fail otherwise.
- *succeeds* if the argument is of the specified type
- *fails* otherwise.
For instance, atom_si(A) yields an *instantiation error* if A is a
For instance, `atom_si(A)` yields an *instantiation error* if `A` is a
variable. This is logically sound, since in that case the argument
is not sufficiently instantiated to make any decision.
The definitions are taken from:
The definitions are taken from [Safer type tests in Prolog](https://stackoverflow.com/questions/27306453/safer-type-tests-in-prolog).
https://stackoverflow.com/questions/27306453/safer-type-tests-in-prolog
Examples:
"si" can also be read as "safe inference", so possibly also other
predicates are candidates for this library.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
```
?- chars_si(Cs).
error(instantiation_error,list_si/1).
?- chars_si([h|Cs]).
error(instantiation_error,list_si/1).
?- chars_si("hello").
true.
?- chars_si(hello).
false.
```
*/
:- module(si, [atom_si/1,
integer_si/1,
atomic_si/1,
list_si/1,
chars_si/1]).
character_si/1,
chars_si/1,
dif_si/2]).
:- use_module(library(lists)).
@@ -53,6 +63,32 @@ list_si(L0) :-
; throw(error(instantiation_error, list_si/1))
).
chars_si(Cs) :-
list_si(Cs),
'$is_partial_string'(Cs).
character_si(Ch) :-
functor(Ch,Ch,0),
atom(Ch),
atom_length(Ch,1).
chars_si(Chs0) :-
'$skip_max_list'(_,_, Chs0,Chs),
( nonvar(Chs) -> Chs == [] ; true ), % fails for infinite lists too
failnochars(Chs0, Uninstantiated),
( nonvar(Uninstantiated)
-> throw(error(instantiation_error, chars_si/1))
; true
).
failnochars(Chs0, U) :-
( var(Chs0) -> U = true
; Chs0 == [] -> true
; Chs0 = [Ch|Chs1],
( nonvar(Ch) -> atom(Ch), atom_length(Ch,1)
; U = true
),
failnochars(Chs1, U)
).
dif_si(X, Y) :-
X \== Y,
( X \= Y -> true
; throw(error(instantiation_error,dif_si/2))
).

View File

@@ -77,9 +77,9 @@ thesis project, for example.
A *linear programming problem* or simply *linear program* (LP)
consists of:
- a set of _linear_ **constraints**
- a set of **variables**
- a _linear_ **objective function**.
- a set of _linear_ *constraints*
- a set of *variables*
- a _linear_ *objective function*.
The goal is to assign values to the variables so as to _maximize_ (or
minimize) the value of the objective function while satisfying all
@@ -107,10 +107,10 @@ non-negativity constraints should therefore be stated explicitly.
This is the "radiation therapy" example, taken from _Introduction to
Operations Research_ by Hillier and Lieberman.
[**Prolog DCG notation**](https://www.metalevel.at/prolog/dcg) is
[*Prolog DCG notation*](https://www.metalevel.at/prolog/dcg) is
used to _implicitly_ thread the state through posting the constraints:
==
```
:- use_module(library(simplex)).
:- use_module(library(dcgs)).
@@ -125,15 +125,15 @@ post_constraints -->
constraint([0.6*x1, 0.4*x2] >= 6),
constraint([x1] >= 0),
constraint([x2] >= 0).
==
```
An example query:
==
```
?- radiation(S), variable_value(S, x1, Val1),
variable_value(S, x2, Val2).
S = solved(...), Val1 = 15 rdiv 2, Val2 = 9 rdiv 2.
==
```
## Example 2 {#simplex-ex-2}
@@ -143,7 +143,7 @@ Here is an instance of the knapsack problem described above, where `C
variables, `x(1)` and `x(2)` that denote how many items to take of
each type.
==
```
:- use_module(library(simplex)).
knapsack(S) :-
@@ -155,15 +155,15 @@ knapsack_constraints(S) :-
constraint([6*x(1), 4*x(2)] =< 8, S0, S1),
constraint([x(1)] =< 1, S1, S2),
constraint([x(2)] =< 2, S2, S).
==
```
An example query yields:
==
```
?- knapsack(S), variable_value(S, x(1), X1),
variable_value(S, x(2), X2).
S = solved(...), X1 = 1 rdiv 1, X2 = 1 rdiv 2.
==
```
That is, we are to take the one item of the first type, and half of one of
the items of the other type to maximize the total value of items in the
@@ -171,23 +171,23 @@ knapsack.
If items can not be split, integrality constraints have to be imposed:
==
```
knapsack_integral(S) :-
knapsack_constraints(S0),
constraint(integral(x(1)), S0, S1),
constraint(integral(x(2)), S1, S2),
maximize([7*x(1), 4*x(2)], S2, S).
==
```
Now the result is different:
==
```
?- knapsack_integral(S), variable_value(S, x(1), X1),
variable_value(S, x(2), X2).
X1 = 0
X2 = 2
==
```
That is, we are to take only the _two_ items of the second type.
Notice in particular that always choosing the remaining item with best
@@ -207,7 +207,7 @@ The task is to find a _minimal_ number of these coins that amount to
111 units in total. We introduce variables `c(1)`, `c(5)` and `c(20)`
denoting how many coins to take of the respective type:
==
```
:- use_module(library(simplex)).
coins(S) :-
@@ -226,16 +226,16 @@ coins -->
constraint(integral(c(5))),
constraint(integral(c(20))),
minimize([c(1), c(5), c(20)]).
==
```
An example query:
==
```
?- coins(S), variable_value(S, c(1), C1),
variable_value(S, c(5), C5),
variable_value(S, c(20), C20).
S = solved(...), C1 = 1 rdiv 1, C5 = 2 rdiv 1, C20 = 5 rdiv 1.
==
```
@author [Markus Triska](https://www.metalevel.at)
*/

View File

@@ -1,4 +1,9 @@
/**
Predicates for handling network sockets, both as a server and as a client.
As a server, you should open a socket an call `socket_server_accept/4` to get a stream for each connection.
As a client, you should just open a socket and you will receive a stream.
In both cases, with a stream, you can use the usual predicates to read and write to the stream.
*/
:- module(sockets, [socket_client_open/3,
socket_server_open/2,
socket_server_accept/4,
@@ -7,6 +12,18 @@
:- use_module(library(error)).
%% socket_client_open(+Addr, -Stream, +Options).
%
% Open a socket to a server, returning a stream. Addr must satisfy `Addr = Address:Port`.
%
% The following options are available:
%
% * `alias(+Alias)`: Set an alias to the stream
% * `eof_action(+Action)`: Defined what happens if the end of the stream is reached. Values: `error`, `eof_code` and `reset`.
% * `reposition(+Boolean)`: Specifies whether repositioning is required for the stream. `false` is the default.
% * `type(+Type)`: Type can be `text` or `binary`. Defines the type of the stream, if it's optimized for plain text
% or just binary
%
socket_client_open(Addr, Stream, Options) :-
( var(Addr) ->
throw(error(instantiation_error, socket_client_open/3))
@@ -27,7 +44,11 @@ socket_client_open(Addr, Stream, Options) :-
socket_client_open/3),
'$socket_client_open'(Address, Port, Stream, Alias, EOFAction, Reposition, Type).
%% socket_server_open(+Addr, -ServerSocket).
%
% Open a server socket, returning a ServerSocket. Use that ServerSocket to accept incoming connections in
% `socket_server_accept/4`. Addr must satisfy `Addr = Address:Port`. Depending on the operating system
% configuration, some ports might be reserved for superusers.
socket_server_open(Addr, ServerSocket) :-
must_be(var, ServerSocket),
( ( integer(Addr) ; var(Addr) ) ->
@@ -39,7 +60,19 @@ socket_server_open(Addr, ServerSocket) :-
'$socket_server_open'(Address, Port, ServerSocket)
).
%% socket_server_accept(+ServerSocket, -Client, -Stream, +Options).
%
% Given a ServerSocket and a list of Options, accepts a incoming connection, returning data from the Client and
% a Stream to read or write data.
%
% The following options are available:
%
% * `alias(+Alias)`: Set an alias to the stream
% * `eof_action(+Action)`: Defined what happens if the end of the stream is reached. Values: `error`, `eof_code` and `reset`.
% * `reposition(+Boolean)`: Specifies whether repositioning is required for the stream. `false` is the default.
% * `type(+Type)`: Type can be `text` or `binary`. Defines the type of the stream, if it's optimized for plain text
% or just binary
%
socket_server_accept(ServerSocket, Client, Stream, Options) :-
must_be(var, Client),
must_be(var, Stream),
@@ -48,10 +81,14 @@ socket_server_accept(ServerSocket, Client, Stream, Options) :-
socket_server_accept/4),
'$socket_server_accept'(ServerSocket, Client, Stream, Alias, EOFAction, Reposition, Type).
%% socket_server_close(+ServerSocket).
%
% Stops listening on that ServerSocket. It's recommended to always close a ServerSocket once it's no longer needed
socket_server_close(ServerSocket) :-
'$socket_server_close'(ServerSocket).
%% current_hostname(-HostName).
%
% Returns the current hostname of the computer in which Scryer Prolog is executing right now
current_hostname(HostName) :-
'$current_hostname'(HostName).

View File

@@ -1,3 +1,29 @@
/** Tabling, also called SLG resolution.
SLG resolution is an alternative execution strategy that sometimes
helps to improve termination and performance characters of Prolog
predicates.
To enable this execution strategy for a Prolog predicate, add a
`(table)/1` directive, using the prefix operator `table` that this
module defines. For example, to enable tabling for the predicate
`p/2`, use:
```
:- use_module(library(tabling)).
:- table p/2.
...
```
The possibility to apply different execution strategies is one of
the greatest attractions of pure Prolog code, and one of the
strongest arguments for keeping to the pure core of Prolog as far
as possible.
Scryer Prolog implements tabling as described by Desouter et al. in [*Tabling as a Library with Delimited Control*](https://www.ijcai.org/Proceedings/16/Papers/619.pdf).
*/
:- module(tabling,
[ start_tabling/2, % +Wrapper, :Worker.
@@ -138,7 +164,9 @@ activate(Wrapper,Worker,T) :-
delim(Wrapper,Worker,Table) :-
% debug(tabling, 'ACT: ~p on ~p', [Wrapper, Table]),
reset(Worker,SourceCall,Continuation),
catch(reset(Worker,SourceCall,Continuation),
_,
fail),
( Continuation = none ->
( add_answer(Table,Wrapper)
-> true %debug(tabling, 'ADD: ~p', [Wrapper])

View File

@@ -49,12 +49,20 @@
:- use_module(library(tabling/double_linked_list)).
:- use_module(library(atts)).
:- use_module(library(dcgs)).
:- use_module(library(lists)).
:- attribute executing_all_work/1, worklist_presence/1, wkl_answer_cluster/1, wkl_suspension_cluster/1, wkl_answer_cluster_pointer_flag/1.
verify_attributes(_, _, []).
attribute_goals(X) -->
{ put_atts(X, -executing_all_work(_)),
put_atts(X, -worklist_presence(_)),
put_atts(X, -wkl_answer_cluster(_)),
put_atts(X, -wkl_suspension_cluster(_)),
put_atts(X, -wkl_answer_cluster_pointer_flag(_)) }.
/** <module> Tabling Worklist management
A batched worklist: a worklist that clusters suspensions and answers as

View File

@@ -49,9 +49,15 @@
]).
:- use_module(library(atts)).
:- use_module(library(dcgs)).
:- attribute dll_element/1, dll_next/1, dll_prev/1.
attribute_goals(X) -->
{ put_atts(X, -dll_element(_)),
put_atts(X, -dll_next(_)),
put_atts(X, -dll_prev(_)) }.
% A circular double linked list
% =============================

View File

@@ -9,12 +9,15 @@
]).
:- use_module(library(atts)).
:- use_module(library(dcgs)).
:- use_module(library(iso_ext)).
:- attribute table_global_worklist/1.
verify_attributes(_, _, []).
attribute_goals(X) --> { put_atts(X, -table_global_worklist(_)) }.
put_new_global_worklist :-
( bb_get(table_global_worklist_initialized, _) ->
true

View File

@@ -56,6 +56,7 @@
:- use_module(library(tabling/batched_worklist)).
:- use_module(library(atts)).
:- use_module(library(dcgs)).
:- use_module(library(gensym)).
:- use_module(library(iso_ext)).
@@ -63,6 +64,10 @@
verify_attributes(_, _, []).
attribute_goals(X) -->
{ put_atts(X, -table_status(_)),
put_atts(X, -newly_created_table_identifiers(_)) }.
% This file defines the table datastructure.
%
% The table datastructure contains the following sub-structures:

View File

@@ -43,6 +43,7 @@
]).
:- use_module(library(atts)).
:- use_module(library(dcgs)).
:- use_module(library(lists)).
:- use_module(library(iso_ext)).
:- use_module(library(terms)).
@@ -53,6 +54,9 @@
verify_attributes(_, _, []).
attribute_goals(X) -->
{ put_atts(X, -trie_table_link(_)) }.
% This file defines a call pattern trie.
%
% This data structure keeps the relation between a variant and the

View File

@@ -45,12 +45,17 @@
:- use_module(library(assoc)).
:- use_module(library(atts)).
:- use_module(library(dcgs)).
:- use_module(library(lists)).
:- attribute maybe_just/1, children/1.
verify_attributes(_, _, []).
attribute_goals(X) -->
{ put_atts(X, -maybe_just(_)),
put_atts(X, -children(_)) }.
% Implementation of a prefix tree, a.k.a. trie %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

View File

@@ -1,47 +1,11 @@
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Written 2020, 2021 by Markus Triska (triska@metalevel.at)
Written 2020-2023 by Markus Triska (triska@metalevel.at)
Part of Scryer Prolog.
This library provides predicates for reasoning about time.
current_time(T) yields the current system time in an opaque form,
called a time stamp. Use format_time//2 to describe strings that
contain attributes of the time stamp.
The nonterminal format_time//2 describes a list of characters that
are formatted according to a format string. Usage:
phrase(format_time(FormatString, TimeStamp), Cs)
TimeStamp represents a moment in time in an opaque form, as for
example obtained by current_time/1.
FormatString is a list of characters that are interpreted literally,
except for the following specifiers (and possibly more in the future):
%Y year of the time stamp. Example: 2020.
%m month number (01-12), zero-padded to 2 digits
%d day number (01-31), zero-padded to 2 digits
%H hour number (00-24), zero-padded to 2 digits
%M minute number (00-59), zero-padded to 2 digits
%S second number (00-60), zero-padded to 2 digits
%b abbreviated month name, always 3 letters
%a abbreviated weekday name, always 3 letters
%A full weekday name
%j day of the year (001-366), zero-padded to 3 digits
%% the literal %
Example:
?- current_time(T), phrase(format_time("%d.%m.%Y (%H:%M:%S)", T), Cs).
T = [...], Cs = "11.06.2020 (00:24:32)".
sleep(S) sleeps for S seconds (a floating point number).
time(Goal) reports the execution time of Goal.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/** This library provides predicates for reasoning about time.
*/
:- module(time, [max_sleep_time/1, sleep/1, time/1, current_time/1, format_time//2]).
:- use_module(library(format)).
@@ -51,10 +15,51 @@
:- use_module(library(lists)).
:- use_module(library(charsio), [read_from_chars/2]).
%% current_time(-T)
%
% Yields the current system time _T_ in an opaque form, called a
% _time stamp_. Use `format_time//2` to describe strings that contain
% attributes of the time stamp.
current_time(T) :-
'$current_time'(T0),
read_from_chars(T0, T).
%% format_time(FormatString, TimeStamp)//
%
% The nonterminal format_time//2 describes a list of characters that
% are formatted according to a format string. Usage:
%
% ```
% phrase(format_time(FormatString, TimeStamp), Cs)
% ```
%
% TimeStamp represents a moment in time in an opaque form, as for
% example obtained by `current_time/1`.
%
% FormatString is a list of characters that are interpreted literally,
% except for the following specifiers (and possibly more in the future):
%
% | `%Y` | year of the time stamp. Example: 2020. |
% | `%m` | month number (01-12), zero-padded to 2 digits |
% | `%d` | day number (01-31), zero-padded to 2 digits |
% | `%H` | hour number (00-24), zero-padded to 2 digits |
% | `%M` | minute number (00-59), zero-padded to 2 digits |
% | `%S` | second number (00-60), zero-padded to 2 digits |
% | `%b` | abbreviated month name, always 3 letters |
% | `%a` | abbreviated weekday name, always 3 letters |
% | `%A` | full weekday name |
% | `%j` | day of the year (001-366), zero-padded to 3 digits |
% | `%%` | the literal `%` |
%
% Example:
%
% ```
% ?- current_time(T), phrase(format_time("%d.%m.%Y (%H:%M:%S)", T), Cs).
% T = [...], Cs = "11.06.2020 (00:24:32)".
% ```
format_time([], _) --> [].
format_time(['%','%'|Fs], T) --> !, "%", format_time(Fs, T).
format_time(['%',Spec|Fs], T) --> !,
@@ -65,8 +70,17 @@ format_time(['%',Spec|Fs], T) --> !,
format_time(Fs, T).
format_time([F|Fs], T) --> [F], format_time(Fs, T).
%% max_sleep_time(T)
%
% The maximum admissible time span for `sleep/1`.
max_sleep_time(0xfffffffffffffbff).
%% sleep(S)
%
% Sleeps for S seconds (a floating point number or integer).
sleep(T) :-
builtins:must_be_number(T, sleep),
( T < 0 ->
@@ -91,6 +105,11 @@ time_next_id(N) :-
),
asserta(time_id(N)).
%% time(Goal)
%
% Reports the execution time of Goal.
time(Goal) :-
'$cpu_now'(T0),
time_next_id(ID),

View File

@@ -53,7 +53,7 @@
connect_ugraph/3 % +Graph1, -Start, -Graph
]).
/** <module> Graph manipulation library
/** Graph manipulation library
The S-representation of a graph is a list of (vertex-neighbours) pairs,
where the pairs are in standard order (as produced by keysort) and the
@@ -61,55 +61,56 @@ neighbours of each vertex are also in standard order (as produced by
sort). This form is convenient for many calculations.
A new UGraph from raw data can be created using
vertices_edges_to_ugraph/3.
`vertices_edges_to_ugraph/3`.
Adapted to support some of the functionality of the SICStus ugraphs
library by Vitor Santos Costa.
Ported from YAP 5.0.1 to SWI-Prolog by Jan Wielemaker.
@author R.A.O'Keefe
@author Vitor Santos Costa
@author Jan Wielemaker
@license BSD-2 or Artistic 2.0
Ported from SWI-Prolog to Scryer by [Adrián Arroyo Calle](https://adrianistan.eu)
License: BSD-2 or Artistic 2.0
*/
:- use_module(library(lists)).
:- use_module(library(pairs)).
:- use_module(library(ordsets)).
%! vertices(+Graph, -Vertices)
%% vertices(+Graph, -Vertices)
%
% Unify Vertices with all vertices appearing in Graph. Example:
% Unify Vertices with all vertices appearing in Graph. Example:
%
% ?- vertices([1-[3,5],2-[4],3-[],4-[5],5-[]], L).
% L = [1, 2, 3, 4, 5]
% ```
% ?- vertices([1-[3,5],2-[4],3-[],4-[5],5-[]], L).
% L = [1, 2, 3, 4, 5]
% ```
vertices([], []) :- !.
vertices([Vertex-_|Graph], [Vertex|Vertices]) :-
vertices(Graph, Vertices).
%! vertices_edges_to_ugraph(+Vertices, +Edges, -UGraph) is det.
%% vertices_edges_to_ugraph(+Vertices, +Edges, -UGraph) is det.
%
% Create a UGraph from Vertices and edges. Given a graph with a
% set of Vertices and a set of Edges, Graph must unify with the
% corresponding S-representation. Note that the vertices without
% edges will appear in Vertices but not in Edges. Moreover, it is
% sufficient for a vertice to appear in Edges.
% Create a UGraph from Vertices and edges. Given a graph with a
% set of Vertices and a set of Edges, Graph must unify with the
% corresponding S-representation. Note that the vertices without
% edges will appear in Vertices but not in Edges. Moreover, it is
% sufficient for a vertice to appear in Edges.
%
% ==
% ?- vertices_edges_to_ugraph([],[1-3,2-4,4-5,1-5], L).
% L = [1-[3,5], 2-[4], 3-[], 4-[5], 5-[]]
% ==
% ```
% ?- vertices_edges_to_ugraph([],[1-3,2-4,4-5,1-5], L).
% L = [1-[3,5], 2-[4], 3-[], 4-[5], 5-[]]
% ```
%
% In this case all vertices are defined implicitly. The next
% example shows three unconnected vertices:
%
% In this case all vertices are defined implicitly. The next
% example shows three unconnected vertices:
%
% ==
% ?- vertices_edges_to_ugraph([6,7,8],[1-3,2-4,4-5,1-5], L).
% L = [1-[3,5], 2-[4], 3-[], 4-[5], 5-[], 6-[], 7-[], 8-[]]
% ==
% ```
% ?- vertices_edges_to_ugraph([6,7,8],[1-3,2-4,4-5,1-5], L).
% L = [1-[3,5], 2-[4], 3-[], 4-[5], 5-[], 6-[], 7-[], 8-[]]
% ```
vertices_edges_to_ugraph(Vertices, Edges, Graph) :-
sort(Edges, EdgeSet),
@@ -119,15 +120,15 @@ vertices_edges_to_ugraph(Vertices, Edges, Graph) :-
p_to_s_group(VertexSet, EdgeSet, Graph).
%! add_vertices(+Graph, +Vertices, -NewGraph)
%% add_vertices(+Graph, +Vertices, -NewGraph)
%
% Unify NewGraph with a new graph obtained by adding the list of
% Vertices to Graph. Example:
% Unify NewGraph with a new graph obtained by adding the list of
% Vertices to Graph. Example:
%
% ```
% ?- add_vertices([1-[3,5],2-[]], [0,1,2,9], NG).
% NG = [0-[], 1-[3,5], 2-[], 9-[]]
% ```
% ```
% ?- add_vertices([1-[3,5],2-[]], [0,1,2,9], NG).
% NG = [0-[], 1-[3,5], 2-[], 9-[]]
% ```
% replace with real msort/2 when available
msort_(List, Sorted) :-
@@ -159,23 +160,18 @@ add_empty_vertices([], []).
add_empty_vertices([V|G], [V-[]|NG]) :-
add_empty_vertices(G, NG).
%! del_vertices(+Graph, +Vertices, -NewGraph) is det.
%% del_vertices(+Graph, +Vertices, -NewGraph) is det.
%
% Unify NewGraph with a new graph obtained by deleting the list of
% Vertices and all the edges that start from or go to a vertex in
% Vertices to the Graph. Example:
% Unify NewGraph with a new graph obtained by deleting the list of
% Vertices and all the edges that start from or go to a vertex in
% Vertices to the Graph. Example:
%
% ==
% ?- del_vertices([1-[3,5],2-[4],3-[],4-[5],5-[],6-[],7-[2,6],8-[]],
% [2,1],
% NL).
% NL = [3-[],4-[5],5-[],6-[],7-[6],8-[]]
% ==
%
% @compat Upto 5.6.48 the argument order was (+Vertices, +Graph,
% -NewGraph). Both YAP and SWI-Prolog have changed the argument
% order for compatibility with recent SICStus as well as
% consistency with del_edges/3.
% ```
% ?- del_vertices([1-[3,5],2-[4],3-[],4-[5],5-[],6-[],7-[2,6],8-[]],
% [2,1],
% NL).
% NL = [3-[],4-[5],5-[],6-[],7-[6],8-[]]
% ```
del_vertices(Graph, Vertices, NewGraph) :-
sort(Vertices, V1), % JW: was msort
@@ -204,32 +200,32 @@ split_on_del_vertices(>, V, Edges, [_|Vs], Vs, V1, [V-NEdges|NG], NG) :-
ord_subtract(Edges, V1, NEdges).
split_on_del_vertices(=, _, _, [_|Vs], Vs, _, NG, NG).
%! add_edges(+Graph, +Edges, -NewGraph)
%% add_edges(+Graph, +Edges, -NewGraph)
%
% Unify NewGraph with a new graph obtained by adding the list of Edges
% to Graph. Example:
% Unify NewGraph with a new graph obtained by adding the list of Edges
% to Graph. Example:
%
% ```
% ?- add_edges([1-[3,5],2-[4],3-[],4-[5],
% 5-[],6-[],7-[],8-[]],
% [1-6,2-3,3-2,5-7,3-2,4-5],
% NL).
% NL = [1-[3,5,6], 2-[3,4], 3-[2], 4-[5],
% 5-[7], 6-[], 7-[], 8-[]]
% ```
% ```
% ?- add_edges([1-[3,5],2-[4],3-[],4-[5],
% 5-[],6-[],7-[],8-[]],
% [1-6,2-3,3-2,5-7,3-2,4-5],
% NL).
% NL = [1-[3,5,6], 2-[3,4], 3-[2], 4-[5],
% 5-[7], 6-[], 7-[], 8-[]]
% ```
add_edges(Graph, Edges, NewGraph) :-
p_to_s_graph(Edges, G1),
ugraph_union(Graph, G1, NewGraph).
%! ugraph_union(+Graph1, +Graph2, -NewGraph)
%% ugraph_union(+Graph1, +Graph2, -NewGraph)
%
% NewGraph is the union of Graph1 and Graph2. Example:
% NewGraph is the union of Graph1 and Graph2. Example:
%
% ```
% ?- ugraph_union([1-[2],2-[3]],[2-[4],3-[1,2,4]],L).
% L = [1-[2], 2-[3,4], 3-[1,2,4]]
% ```
% ```
% ?- ugraph_union([1-[2],2-[3]],[2-[4],3-[1,2,4]],L).
% L = [1-[2], 2-[3,4], 3-[1,2,4]]
% ```
ugraph_union(Set1, [], Set1) :- !.
ugraph_union([], Set2, Set2) :- !.
@@ -245,25 +241,25 @@ ugraph_union(<, Head1, Tail1, Head2, Tail2, [Head1|Union]) :-
ugraph_union(>, Head1, Tail1, Head2, Tail2, [Head2|Union]) :-
ugraph_union([Head1|Tail1], Tail2, Union).
%! del_edges(+Graph, +Edges, -NewGraph)
%% del_edges(+Graph, +Edges, -NewGraph)
%
% Unify NewGraph with a new graph obtained by removing the list of
% Edges from Graph. Notice that no vertices are deleted. Example:
% Unify NewGraph with a new graph obtained by removing the list of
% Edges from Graph. Notice that no vertices are deleted. Example:
%
% ```
% ?- del_edges([1-[3,5],2-[4],3-[],4-[5],5-[],6-[],7-[],8-[]],
% [1-6,2-3,3-2,5-7,3-2,4-5,1-3],
% NL).
% NL = [1-[5],2-[4],3-[],4-[],5-[],6-[],7-[],8-[]]
% ```
% ```
% ?- del_edges([1-[3,5],2-[4],3-[],4-[5],5-[],6-[],7-[],8-[]],
% [1-6,2-3,3-2,5-7,3-2,4-5,1-3],
% NL).
% NL = [1-[5],2-[4],3-[],4-[],5-[],6-[],7-[],8-[]]
% ```
del_edges(Graph, Edges, NewGraph) :-
p_to_s_graph(Edges, G1),
graph_subtract(Graph, G1, NewGraph).
%! graph_subtract(+Set1, +Set2, ?Difference)
%% graph_subtract(+Set1, +Set2, ?Difference)
%
% Is based on ord_subtract
% Is based on `ord_subtract/3`
graph_subtract(Set1, [], Set1) :- !.
graph_subtract([], _, []).
@@ -279,12 +275,14 @@ graph_subtract(<, Head1, Tail1, Head2, Tail2, [Head1|Difference]) :-
graph_subtract(>, Head1, Tail1, _, Tail2, Difference) :-
graph_subtract([Head1|Tail1], Tail2, Difference).
%! edges(+Graph, -Edges)
%% edges(+Graph, -Edges)
%
% Unify Edges with all edges appearing in Graph. Example:
% Unify Edges with all edges appearing in Graph. Example:
%
% ?- edges([1-[3,5],2-[4],3-[],4-[5],5-[]], L).
% L = [1-3, 1-5, 2-4, 4-5]
% ```
% ?- edges([1-[3,5],2-[4],3-[],4-[5],5-[]], L).
% L = [1-3, 1-5, 2-4, 4-5]
% ```
edges(Graph, Edges) :-
s_to_p_graph(Graph, Edges).
@@ -324,15 +322,15 @@ s_to_p_graph([], _, P_Graph, P_Graph) :- !.
s_to_p_graph([Neib|Neibs], Vertex, [Vertex-Neib|P], Rest_P) :-
s_to_p_graph(Neibs, Vertex, P, Rest_P).
%! transitive_closure(+Graph, -Closure)
%% transitive_closure(+Graph, -Closure)
%
% Generate the graph Closure as the transitive closure of Graph.
% Example:
% Generate the graph Closure as the transitive closure of Graph.
% Example:
%
% ```
% ?- transitive_closure([1-[2,3],2-[4,5],4-[6]],L).
% L = [1-[2,3,4,5,6], 2-[4,5,6], 4-[6]]
% ```
% ```
% ?- transitive_closure([1-[2,3],2-[4,5],4-[6]],L).
% L = [1-[2,3,4,5,6], 2-[4,5,6], 4-[6]]
% ```
transitive_closure(Graph, Closure) :-
warshall(Graph, Graph, Closure).
@@ -354,23 +352,18 @@ warshall([X-Neibs|G], V, Y, [X-Neibs|NewG]) :-
warshall(G, V, Y, NewG).
warshall([], _, _, []).
%! transpose_ugraph(Graph, NewGraph) is det.
%% transpose_ugraph(Graph, NewGraph) is det.
%
% Unify NewGraph with a new graph obtained from Graph by replacing
% all edges of the form V1-V2 by edges of the form V2-V1. The cost
% is O(|V|*log(|V|)). Notice that an undirected graph is its own
% transpose. Example:
% Unify NewGraph with a new graph obtained from Graph by replacing
% all edges of the form V1-V2 by edges of the form V2-V1. The cost
% is O(|V|\*log(|V|)). Notice that an undirected graph is its own
% transpose. Example:
%
% ==
% ?- transpose([1-[3,5],2-[4],3-[],4-[5],
% 5-[],6-[],7-[],8-[]], NL).
% NL = [1-[],2-[],3-[1],4-[2],5-[1,4],6-[],7-[],8-[]]
% ==
%
% @compat This predicate used to be known as transpose/2.
% Following SICStus 4, we reserve transpose/2 for matrix
% transposition and renamed ugraph transposition to
% transpose_ugraph/2.
% ```
% ?- transpose([1-[3,5],2-[4],3-[],4-[5],
% 5-[],6-[],7-[],8-[]], NL).
% NL = [1-[],2-[],3-[1],4-[2],5-[1,4],6-[],7-[],8-[]]
% ```
transpose_ugraph(Graph, NewGraph) :-
edges(Graph, Edges),
@@ -382,13 +375,15 @@ flip_edges([], []).
flip_edges([Key-Val|Pairs], [Val-Key|Flipped]) :-
flip_edges(Pairs, Flipped).
%! compose(+LeftGraph, +RightGraph, -NewGraph)
%% compose(+LeftGraph, +RightGraph, -NewGraph)
%
% Compose NewGraph by connecting the _drains_ of LeftGraph to the
% _sources_ of RightGraph. Example:
% Compose NewGraph by connecting the _drains_ of LeftGraph to the
% _sources_ of RightGraph. Example:
%
% ?- compose([1-[2],2-[3]],[2-[4],3-[1,2,4]],L).
% L = [1-[4], 2-[1,2,4], 3-[]]
% ```
% ?- compose([1-[2],2-[3]],[2-[4],3-[1,2,4]],L).
% L = [1-[4], 2-[1,2,4], 3-[]]
% ```
compose(G1, G2, Composition) :-
vertices(G1, V1),
@@ -423,21 +418,17 @@ compose1(=, V1, Vs1, V1, N2, G2, SoFar, Comp) :-
ord_union(N2, SoFar, Next),
compose1(Vs1, G2, Next, Comp).
%! top_sort(+Graph, -Sorted) is semidet.
%! top_sort(+Graph, -Sorted, ?Tail) is semidet.
%% top_sort(+Graph, -Sorted) is semidet.
%
% Sorted is a topological sorted list of nodes in Graph. A
% toplogical sort is possible if the graph is connected and
% acyclic. In the example we show how topological sorting works
% for a linear graph:
% Sorted is a topological sorted list of nodes in Graph. A
% toplogical sort is possible if the graph is connected and
% acyclic. In the example we show how topological sorting works
% for a linear graph:
%
% ==
% ?- top_sort([1-[2], 2-[3], 3-[]], L).
% L = [1, 2, 3]
% ==
%
% The predicate top_sort/3 is a difference list version of
% top_sort/2.
% ```
% ?- top_sort([1-[2], 2-[3], 3-[]], L).
% L = [1, 2, 3]
% ```
top_sort(Graph, Sorted) :-
vertices_and_zeros(Graph, Vertices, Counts0),
@@ -445,6 +436,11 @@ top_sort(Graph, Sorted) :-
select_zeros(Counts1, Vertices, Zeros),
top_sort(Zeros, Sorted, Graph, Vertices, Counts1).
%% top_sort(+Graph, -Sorted, ?Tail) is semidet.
%
% The predicate `top_sort/3` is a difference list version of
% `top_sort/2`.
top_sort(Graph, Sorted0, Sorted) :-
vertices_and_zeros(Graph, Vertices, Counts0),
count_edges(Graph, Vertices, Counts0, Counts1),
@@ -520,17 +516,21 @@ decr_list(Neibs, [_|Vertices], [N|Counts1], [N|Counts2], Zi, Zo) :-
decr_list(Neibs, Vertices, Counts1, Counts2, Zi, Zo).
%! neighbors(+Vertex, +Graph, -Neigbours) is det.
%! neighbours(+Vertex, +Graph, -Neigbours) is det.
%% neighbours(+Vertex, +Graph, -Neigbours) is det.
%
% Neigbours is a sorted list of the neighbours of Vertex in Graph.
% Example:
% Neigbours is a sorted list of the neighbours of Vertex in Graph.
% Example:
%
% ```
% ?- neighbours(4,[1-[3,5],2-[4],3-[],
% 4-[1,2,7,5],5-[],6-[],7-[],8-[]], NL).
% NL = [1,2,7,5]
% ```
% ```
% ?- neighbours(4,[1-[3,5],2-[4],3-[],
% 4-[1,2,7,5],5-[],6-[],7-[],8-[]], NL).
% NL = [1,2,7,5]
% ```
%% neighbors(+Vertex, +Graph, -Neigbours) is det.
%
% Same as `neighbours/3`.
neighbors(Vertex, Graph, Neig) :-
neighbours(Vertex, Graph, Neig).
@@ -542,24 +542,24 @@ neighbours(V,[_|G],Neig) :-
neighbours(V,G,Neig).
%! connect_ugraph(+UGraphIn, -Start, -UGraphOut) is det.
%% connect_ugraph(+UGraphIn, -Start, -UGraphOut) is det.
%
% Adds Start as an additional vertex that is connected to all vertices
% in UGraphIn. This can be used to create an topological sort for a
% not connected graph. Start is before any vertex in UGraphIn in the
% standard order of terms. No vertex in UGraphIn can be a variable.
% Adds Start as an additional vertex that is connected to all vertices
% in UGraphIn. This can be used to create an topological sort for a
% not connected graph. Start is before any vertex in UGraphIn in the
% standard order of terms. No vertex in UGraphIn can be a variable.
%
% Can be used to order a not-connected graph as follows:
% Can be used to order a not-connected graph as follows:
%
% ```
% top_sort_unconnected(Graph, Vertices) :-
% ( top_sort(Graph, Vertices)
% -> true
% ; connect_ugraph(Graph, Start, Connected),
% top_sort(Connected, Ordered0),
% Ordered0 = [Start|Vertices]
% ).
% ```
% ```
% top_sort_unconnected(Graph, Vertices) :-
% ( top_sort(Graph, Vertices)
% -> true
% ; connect_ugraph(Graph, Start, Connected),
% top_sort(Connected, Ordered0),
% Ordered0 = [Start|Vertices]
% ).
% ```
connect_ugraph([], 0, []) :- !.
connect_ugraph(Graph, Start, [Start-Vertices|Graph]) :-
@@ -567,12 +567,12 @@ connect_ugraph(Graph, Start, [Start-Vertices|Graph]) :-
Vertices = [First|_],
before(First, Start).
%! before(+Term, -Before) is det.
%% before(+Term, -Before) is det.
%
% Unify Before to a term that comes before Term in the standard
% order of terms.
% Unify Before to a term that comes before Term in the standard
% order of terms.
%
% @error instantiation_error if Term is unbound.
% Throws `instantiation_error` if Term is unbound.
before(X, _) :-
var(X),
@@ -585,21 +585,22 @@ before(Number, Start) :-
before(_, 0).
%! complement(+UGraphIn, -UGraphOut)
%% complement(+UGraphIn, -UGraphOut)
%
% UGraphOut is a ugraph with an edge between all vertices that are
% _not_ connected in UGraphIn and all edges from UGraphIn removed.
% Example:
% UGraphOut is a ugraph with an edge between all vertices that are
% _not_ connected in UGraphIn and all edges from UGraphIn removed.
% Example:
%
% ```
% ?- complement([1-[3,5],2-[4],3-[],
% 4-[1,2,7,5],5-[],6-[],7-[],8-[]], NL).
% NL = [1-[2,4,6,7,8],2-[1,3,5,6,7,8],3-[1,2,4,5,6,7,8],
% 4-[3,5,6,8],5-[1,2,3,4,6,7,8],6-[1,2,3,4,5,7,8],
% 7-[1,2,3,4,5,6,8],8-[1,2,3,4,5,6,7]]
% ```
%
% @tbd Simple two-step algorithm. You could be smarter, I suppose.
% ```
% ?- complement([1-[3,5],2-[4],3-[],
% 4-[1,2,7,5],5-[],6-[],7-[],8-[]], NL).
% NL = [1-[2,4,6,7,8],2-[1,3,5,6,7,8],3-[1,2,4,5,6,7,8],
% 4-[3,5,6,8],5-[1,2,3,4,6,7,8],6-[1,2,3,4,5,7,8],
% 7-[1,2,3,4,5,6,8],8-[1,2,3,4,5,6,7]]
% ```
% TODO: Simple two-step algorithm. You could be smarter, I suppose.
complement(G, NG) :-
vertices(G,Vs),
@@ -611,13 +612,15 @@ complement([V-Ns|G], Vs, [V-INs|NG]) :-
ord_subtract(Vs,Ns1,INs),
complement(G, Vs, NG).
%! reachable(+Vertex, +UGraph, -Vertices)
%% reachable(+Vertex, +UGraph, -Vertices)
%
% True when Vertices is an ordered set of vertices reachable in
% UGraph, including Vertex. Example:
% True when Vertices is an ordered set of vertices reachable in
% UGraph, including Vertex. Example:
%
% ?- reachable(1,[1-[3,5],2-[4],3-[],4-[5],5-[]],V).
% V = [1, 3, 5]
% ```
% ?- reachable(1,[1-[3,5],2-[4],3-[],4-[5],5-[]],V).
% V = [1, 3, 5]
% ```
reachable(N, G, Rs) :-
reachable([N], G, [N], Rs).

View File

@@ -1,25 +1,32 @@
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Written in February 2021 by Adrián Arroyo (adrian.arroyocalle@gmail.com)
Part of Scryer-Prolog
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
* 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|...].
?- uuidv4_string(X).
X = "428499fc-76e3-4240- ...".
?- uuidv4(X), uuid_string(X, S).
X = [173,12,244,152,139,118,64,139,137,4|...], S = "ad0cf498-8b76-408b- ...".
?- uuid_string(X, "61ae692e-eaf6-4199-8dd3-9f01db70a20b").
X = [97,174,105,46,234,246,65,153,141,211|...].
I place this code in the public domain. Use it in any way you want.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/**
This library provides reasoning and working with [UUID](https://en.wikipedia.org/wiki/Universally_unique_identifier)
(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
* `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|...].
?- uuidv4_string(X).
X = "428499fc-76e3-4240- ...".
?- uuidv4(X), uuid_string(X, S).
X = [173,12,244,152,139,118,64,139,137,4|...], S = "ad0cf498-8b76-408b- ...".
?- uuid_string(X, "61ae692e-eaf6-4199-8dd3-9f01db70a20b").
X = [97,174,105,46,234,246,65,153,141,211|...].
*/
:- module(uuid, [
uuidv4/1,
uuidv4_string/1,
@@ -39,6 +46,10 @@ clock_seq_hi_and_res_clock_seq_low - 2
node - 6
UUID v4 can be generated from a set of 16 random bytes: https://www.rfc-archive.org/getrfc.php?rfc=4122#gsc.tab=0 (section 4.4)
*/
%% uuidv4(-Uuid).
%
% Generates a new UUID v4 (random). It unifies with a list of bytes.
uuidv4(Uuid) :-
crypto_n_random_bytes(16, Bytes),
Bytes = [B1, B2, B3, B4, B5, B6, B7, B8, B9, B10, B11, B12, B13, B14, B15, B16],
@@ -52,8 +63,15 @@ uuidv4(Uuid) :-
byte_bits(NewTimeHi, NewBitsTimeHi),
Uuid = [B1, B2, B3, B4, B5, B6, NewTimeHi, B8, NewClockSeqHi0, B10, B11, B12, B13, B14, B15, B16].
%% uuidv4_string(-UuidString).
%
% Generates a new UUID v4 (random). It unifies with a string representation of the UUID.
% It is equivalent of calling `uuidv4/1` followed by `uuid_string/2`.
uuidv4_string(String) :- uuidv4(Uuid), uuid_string(Uuid, String).
%% uuid_string(?UuidBytes, ?UuidString).
%
% Translates between the bytes representation and the string representation of the same UUID.
uuid_string(Uuid, String) :-
Uuid = [B1, B2, B3, B4, B5, B6, B7, B8, B9, B10, B11, B12, B13, B14, B15, B16],
phrase(uuid_([S1, S2, S3, S4, S5]), String),

View File

@@ -95,219 +95,221 @@
op(200, fy, @)
]).
:- use_module(library(lists),[member/2,memberchk/2]).
:- use_module(library(lists),[member/2,memberchk/2,reverse/2]).
:- use_module(library(charsio)).
:- use_module(library(error)).
:- use_module(library(dcgs)).
:- use_module(library(si)).
/** <module> Select nodes in an XML DOM
/** Select nodes in an XML DOM
The library xpath.pl provides predicates to select nodes from an XML DOM
tree as produced by library(sgml) based on descriptions inspired by the
XPath language.
tree as produced by `library(sgml)` based on descriptions inspired by the
[XPath language](http://www.w3.org/TR/xpath).
The predicate xpath/3 selects a sub-structure of the DOM
The predicate `xpath/3` selects a sub-structure of the DOM
non-deterministically based on an XPath-like specification. Not all
selectors of XPath are implemented, but the ability to mix xpath/3 calls
selectors of XPath are implemented, but the ability to mix `xpath/3` calls
with arbitrary Prolog code provides a powerful tool for extracting
information from XML parse-trees.
@see http://www.w3.org/TR/xpath
*/
element_name(element(Name,_,_), Name).
element_attributes(element(_,Attributes,_), Attributes).
element_content(element(_,_,Content), Content).
%! xpath_chk(+DOM, +Spec, ?Content) is semidet.
%% xpath_chk(+DOM, +Spec, ?Content) is semidet.
%
% Semi-deterministic version of xpath/3.
% Semi-deterministic version of `xpath/3`.
xpath_chk(DOM, Spec, Content) :-
xpath(DOM, Spec, Content),
!.
%! xpath(+DOM, +Spec, ?Content) is nondet.
%% xpath(+DOM, +Spec, ?Content) is nondet.
%
% Match an element in a DOM structure. The syntax is inspired by
% XPath, using () rather than [] to select inside an element.
% First we can construct paths using / and //:
% Match an element in a DOM structure. The syntax is inspired by
% XPath, using () rather than [] to select inside an element.
% First we can construct paths using / and //:
%
% $ =|//|=Term :
% Select any node in the DOM matching term.
% $ =|/|=Term :
% Match the root against Term.
% $ Term :
% Select the immediate children of the root matching Term.
% - *//Term*
% Select any node in the DOM matching term.
%
% The Terms above are of type _callable_. The functor specifies
% the element name. The element name '*' refers to any element.
% The name =self= refers to the top-element itself and is often
% used for processing matches of an earlier xpath/3 query. A term
% NS:Term refers to an XML name in the namespace NS. Optional
% arguments specify additional constraints and functions. The
% arguments are processed from left to right. Defined conditional
% argument values are:
% - */Term*
% Match the root against Term.
%
% $ index(?Index) :
% True if the element is the Index-th child of its parent,
% where 1 denotes the first child. Index can be one of:
% $ `Var` :
% `Var` is unified with the index of the matched element.
% $ =last= :
% True for the last element.
% $ =last= - `IntExpr` :
% True for the last-minus-nth element. For example,
% `last-1` is the element directly preceding the last one.
% $ `IntExpr` :
% True for the element whose index equals `IntExpr`.
% $ Integer :
% The N-th element with the given name, with 1 denoting the
% first element. Same as index(Integer).
% $ =last= :
% The last element with the given name. Same as
% index(last).
% $ =last= - IntExpr :
% The IntExpr-th element before the last.
% Same as index(last-IntExpr).
% - *Term*
% Select the immediate children of the root matching Term.
%
% Defined function argument values are:
% The Terms above are of type _callable_. The functor specifies
% the element name. The element name `*` refers to any element.
% The name _self_ refers to the top-element itself and is often
% used for processing matches of an earlier `xpath/3` query. A term
% NS:Term refers to an XML name in the namespace NS. Optional
% arguments specify additional constraints and functions. The
% arguments are processed from left to right. Defined conditional
% argument values are:
%
% $ =self= :
% Evaluate to the entire element
% $ =content= :
% Evaluate to the content of the element (a list)
% $ =text= :
% Evaluates to all text from the sub-tree, represented
% as a list of characters.
% $ `text(atom)` :
% Evaluates to all text from the sub-tree as an atom.
% $ =normalize_space= :
% As =text=, but uses normalize_space/2 to normalise
% white-space in the output
% $ =number= :
% Extract an integer or float from the value. Ignores
% leading and trailing white-space
% $ =|@|=Attribute :
% Evaluates to the value of the given attribute. Attribute
% can be a compound term. In this case the functor name
% denotes the element and arguments perform transformations
% on the attribute value. Defined transformations are:
% - *`index(?Index)`*
% True if the element is the Index-th child of its parent,
% where 1 denotes the first child. Index can be one of:
%
% - number
% Translate the value into a number using
% xsd_number_chars/2.
% - integer
% As `number`, but subsequently transform the value
% into an integer using the round/1 function.
% - float
% As `number`, but subsequently transform the value
% into a float using the float/1 function.
% - lower
% Translate the value to lower case, preserving
% the type.
% - upper
% Translate the value to upper case, preserving
% the type.
% - *`Var`*
% `Var` is unified with the index of the matched element.
% - *`last`*
% True for the last element.
% - *`last - IntExpr`*
% True for the last-minus-nth element. For example,
% `last-1` is the element directly preceding the last one.
% - *`IntExpr`*
% True for the element whose index equals `IntExpr`.
% - *`Integer`*
% The N-th element with the given name, with 1 denoting the
% first element. Same as `index(Integer)`.
% - *`last`*
% The last element with the given name. Same as
% `index(last)`.
% - *`last - IntExpr`*
% The IntExpr-th element before the last.
% Same as `index(last-IntExpr)`.
%
% In addition, the argument-list can be _conditions_:
% Defined function argument values are:
%
% $ Left = Right :
% Succeeds if the left-hand unifies with the right-hand.
% If the left-hand side is a function, this is evaluated.
% The right-hand side is _never_ evaluated, and thus the
% condition `content = content` defines that the content
% of the element is the atom `content`.
% The functions `lower_case` and `upper_case` can be applied
% to Right (see example below).
% $ contains(Haystack, Needle) :
% Succeeds if Needle is a sub-list of Haystack.
% $ XPath :
% Succeeds if XPath matches in the currently selected
% sub-DOM. For example, the following expression finds
% an =h3= element inside a =div= element, where the =div=
% element itself contains an =h2= child with a =strong=
% child.
% - *`self`*
% Evaluate to the entire element
% - *`content`*
% Evaluate to the content of the element (a list)
% - *`text`*
% Evaluates to all text from the sub-tree, represented
% as a list of characters.
% - *`text(atom)`*
% Evaluates to all text from the sub-tree as an atom.
% - *`normalize_space`*
% As `text`, but uses `normalize_space/2` to normalise
% white-space in the output
% - *`number`*
% Extract an integer or float from the value. Ignores
% leading and trailing white-space
% - *`@Attribute`*
% Evaluates to the value of the given attribute. Attribute
% can be a compound term. In this case the functor name
% denotes the element and arguments perform transformations
% on the attribute value. Defined transformations are:
%
% ==
% //div(h2/strong)/h3
% ==
% - *`number`*
% Translate the value into a number using
% `xsd_number_chars/2`.
% - *`integer`*
% As `number`, but subsequently transform the value
% into an integer using the `round/1` function.
% - *`float`*
% As `number`, but subsequently transform the value
% into a float using the `float/1` function.
% - *`lower`*
% Translate the value to lower case, preserving
% the type.
% - *`upper`*
% Translate the value to upper case, preserving
% the type.
%
% This is equivalent to the conjunction of XPath goals below.
% In addition, the argument-list can be _conditions_:
%
% ==
% ...,
% xpath(DOM, //(div), Div),
% xpath(Div, h2/strong, _),
% xpath(Div, h3, Result)
% ==
% - *`Left = Right`*
% Succeeds if the left-hand unifies with the right-hand.
% If the left-hand side is a function, this is evaluated.
% The right-hand side is _never_ evaluated, and thus the
% condition `content = content` defines that the content
% of the element is the atom `content`.
% The functions `lower_case` and `upper_case` can be applied
% to Right (see example below).
% - *`contains(Haystack, Needle)`*
% Succeeds if Needle is a sub-list of Haystack.
% - *`XPath`*
% Succeeds if XPath matches in the currently selected
% sub-DOM. For example, the following expression finds
% an `h3` element inside a `div` element, where the `div`
% element itself contains an `h2` child with a `strong`
% child.
%
% **Examples**:
% ```
% //div(h2/strong)/h3
% ```
%
% Match each table-row in DOM:
% This is equivalent to the conjunction of XPath goals below.
%
% ==
% xpath(DOM, //tr, TR)
% ==
% ```
% ...,
% xpath(DOM, //(div), Div),
% xpath(Div, h2/strong, _),
% xpath(Div, h3, Result)
% ```
%
% Match the last cell of each tablerow in DOM. This example
% illustrates that a result can be the input of subsequent xpath/3
% queries. Using multiple queries on the intermediate TR term
% guarantee that all results come from the same table-row:
% #### Examples
%
% ==
% xpath(DOM, //tr, TR),
% xpath(TR, /td(last), TD)
% ==
% Match each table-row in DOM:
%
% Match each =href= attribute in an <a> element
% ```
% xpath(DOM, //tr, TR)
% ```
%
% ==
% xpath(DOM, //a(@href), HREF)
% ==
% Match the last cell of each tablerow in DOM. This example
% illustrates that a result can be the input of subsequent `xpath/3`
% queries. Using multiple queries on the intermediate TR term
% guarantee that all results come from the same table-row:
%
% Suppose we have a table containing rows where each first column
% is the name of a product with a link to details and the second
% is the price (a number). The following predicate matches the
% name, URL and price:
% ```
% xpath(DOM, //tr, TR),
% xpath(TR, /td(last), TD)
% ```
%
% ==
% product(DOM, Name, URL, Price) :-
% xpath(DOM, //tr, TR),
% xpath(TR, td(1), C1),
% xpath(C1, /self(normalize_space), Name),
% xpath(C1, a(@href), URL),
% xpath(TR, td(2, number), Price).
% ==
% Match each `href` attribute in an `<a>` element
%
% Suppose we want to select books with genre="thriller" from a
% tree containing elements =|<book genre=...>|=
% ```
% xpath(DOM, //a(@href), HREF)
% ```
%
% ==
% thriller(DOM, Book) :-
% xpath(DOM, //book(@genre=thiller), Book).
% ==
% Suppose we have a table containing rows where each first column
% is the name of a product with a link to details and the second
% is the price (a number). The following predicate matches the
% name, URL and price:
%
% Match the elements =|<table align="center">|= _and_ =|<table
% align="CENTER">|=:
% ```
% product(DOM, Name, URL, Price) :-
% xpath(DOM, //tr, TR),
% xpath(TR, td(1), C1),
% xpath(C1, /self(normalize_space), Name),
% xpath(C1, a(@href), URL),
% xpath(TR, td(2, number), Price).
% ```
%
% ```prolog
% //table(@align(lower) = center)
% ```
% Suppose we want to select books with genre="thriller" from a
% tree containing elements `<book genre=...>`
%
% Get the `width` and `height` of a `div` element as a number,
% and the `div` node itself:
% ```
% thriller(DOM, Book) :-
% xpath(DOM, //book(@genre=thiller), Book).
% ```
%
% ==
% xpath(DOM, //div(@width(number)=W, @height(number)=H), Div)
% ==
% Match the elements `<table align="center">` _and_ `<table
% align="CENTER">`:
%
% Note that `div` is an infix operator, so parentheses must be
% used in cases like the following:
% ```
% //table(@align(lower) = center)
% ```
%
% ==
% xpath(DOM, //(div), Div)
% ==
% Get the `width` and `height` of a `div` element as a number,
% and the `div` node itself:
%
% ```
% xpath(DOM, //div(@width(number)=W, @height(number)=H), Div)
% ```
%
% Note that `div` is an infix operator, so parentheses must be
% used in cases like the following:
%
% ```
% xpath(DOM, //(div), Div)
% ```
xpath(DOM, Spec, Content) :-
in_dom(Spec, DOM, Content).
@@ -635,5 +637,27 @@ text_of_1([C|Cs]) --> seq([C|Cs]).
xsd_number_chars(Number, Chars) :-
number_chars(Number, Chars).
normalize_space(Text0, Text) :-
Text0 = Text. % no conversion for the moment.
normalize_space(Cs0, Cs) :-
must_be(chars, Cs0),
no_leading_whitespace(Cs0, Cs1),
reverse(Cs1, Cs2),
no_leading_whitespace(Cs2, Cs3),
reverse(Cs3, Cs4),
single_intermediate_space(Cs4, Cs).
no_leading_whitespace([], []).
no_leading_whitespace([C0|Cs0], Cs) :-
( char_type(C0, whitespace) ->
no_leading_whitespace(Cs0, Cs)
; Cs = [C0|Cs0]
).
single_intermediate_space([], []).
single_intermediate_space([C0|Cs0], [C|Cs]) :-
( char_type(C0, whitespace) ->
no_leading_whitespace(Cs0, Cs1),
C = ' ',
single_intermediate_space(Cs1, Cs)
; C = C0,
single_intermediate_space(Cs0, Cs)
).

File diff suppressed because it is too large Load Diff

View File

@@ -1,4 +1,8 @@
use dashu::base::{Abs, Gcd, Signed, UnsignedAbs};
use dashu::integer::IBig;
use dashu::integer::fast_div::ConstDivisor;
use divrem::*;
use num_order::NumOrd;
use crate::arena::*;
use crate::arithmetic::*;
@@ -8,7 +12,7 @@ use crate::heap_iter::*;
use crate::machine::machine_errors::*;
use crate::machine::machine_state::*;
use crate::parser::ast::*;
use crate::parser::rug::{Integer, Rational};
use crate::parser::dashu::{Integer, Rational};
use crate::types::*;
use crate::fixnum;
@@ -47,9 +51,7 @@ macro_rules! drop_iter_on_err {
};
}
fn zero_divisor_eval_error(
stub_gen: impl Fn() -> FunctorStub + 'static,
) -> MachineStubGen {
fn zero_divisor_eval_error(stub_gen: impl Fn() -> FunctorStub + 'static) -> MachineStubGen {
Box::new(move |machine_st| {
let eval_error = machine_st.evaluation_error(EvalError::ZeroDivisor);
let stub = stub_gen();
@@ -58,9 +60,7 @@ fn zero_divisor_eval_error(
})
}
fn undefined_eval_error(
stub_gen: impl Fn() -> FunctorStub + 'static,
) -> MachineStubGen {
fn undefined_eval_error(stub_gen: impl Fn() -> FunctorStub + 'static) -> MachineStubGen {
Box::new(move |machine_st| {
let eval_error = machine_st.evaluation_error(EvalError::Undefined);
let stub = stub_gen();
@@ -159,16 +159,14 @@ pub(crate) fn add(lhs: Number, rhs: Number, arena: &mut Arena) -> Result<Number,
Ok(Number::Float(add_f(float_fn_to_f(n1.get_num())?, n2)?))
}
(Number::Integer(n1), Number::Integer(n2)) => {
Ok(Number::arena_from(Integer::from(&*n1) + &*n2, arena)) // add_i
Ok(Number::arena_from(&*n1 + &*n2, arena)) // add_i
}
(Number::Integer(n1), Number::Float(OrderedFloat(n2)))
| (Number::Float(OrderedFloat(n2)), Number::Integer(n1)) => {
Ok(Number::Float(add_f(float_i_to_f(&n1)?, n2)?))
}
(Number::Integer(n1), Number::Rational(n2))
| (Number::Rational(n2), Number::Integer(n1)) => {
Ok(Number::arena_from(Rational::from(&*n1) + &*n2, arena))
}
| (Number::Rational(n2), Number::Integer(n1)) => Ok(Number::arena_from(&*n1 + &*n2, arena)),
(Number::Rational(n1), Number::Float(OrderedFloat(n2)))
| (Number::Float(OrderedFloat(n2)), Number::Rational(n1)) => {
Ok(Number::Float(add_f(float_r_to_f(&n1)?, n2)?))
@@ -176,9 +174,7 @@ pub(crate) fn add(lhs: Number, rhs: Number, arena: &mut Arena) -> Result<Number,
(Number::Float(OrderedFloat(f1)), Number::Float(OrderedFloat(f2))) => {
Ok(Number::Float(add_f(f1, f2)?))
}
(Number::Rational(r1), Number::Rational(r2)) => {
Ok(Number::arena_from(Rational::from(&*r1) + &*r2, arena))
}
(Number::Rational(r1), Number::Rational(r2)) => Ok(Number::arena_from(&*r1 + &*r2, arena)),
}
}
@@ -191,9 +187,15 @@ pub(crate) fn neg(n: Number, arena: &mut Arena) -> Number {
Number::arena_from(-Integer::from(n.get_num()), arena)
}
}
Number::Integer(n) => Number::arena_from(-Integer::from(&*n), arena),
Number::Integer(n) => {
let n_clone: Integer = (*n).clone();
Number::arena_from(-Integer::from(n_clone), arena)
}
Number::Float(OrderedFloat(f)) => Number::Float(OrderedFloat(-f)),
Number::Rational(r) => Number::arena_from(-Rational::from(&*r), arena),
Number::Rational(r) => {
let r_clone: Rational = (*r).clone();
Number::arena_from(-Rational::from(r_clone), arena)
}
}
}
@@ -203,12 +205,19 @@ pub(crate) fn abs(n: Number, arena: &mut Arena) -> Number {
if let Some(n) = n.get_num().checked_abs() {
fixnum!(Number, n, arena)
} else {
Number::arena_from(Integer::from(n.get_num()).abs(), arena)
let arena_int = Integer::from(n.get_num());
Number::arena_from(arena_int.abs(), arena)
}
}
Number::Integer(n) => Number::arena_from(Integer::from(n.abs_ref()), arena),
Number::Integer(n) => {
let n_clone: Integer = (*n).clone();
Number::arena_from(Integer::from(n_clone.abs()), arena)
}
Number::Float(f) => Number::Float(f.abs()),
Number::Rational(r) => Number::arena_from(Rational::from(r.abs_ref()), arena),
Number::Rational(r) => {
let r_clone: Rational = (*r).clone();
Number::arena_from(Rational::from(r_clone.abs()), arena)
}
}
}
@@ -247,7 +256,8 @@ pub(crate) fn mul(lhs: Number, rhs: Number, arena: &mut Arena) -> Result<Number,
Ok(Number::Float(mul_f(float_fn_to_f(n1.get_num())?, n2)?))
}
(Number::Integer(n1), Number::Integer(n2)) => {
Ok(Number::arena_from(Integer::from(&*n1) * &*n2, arena)) // mul_i
let n1_clone: Integer = (*n1).clone();
Ok(Number::arena_from(Integer::from(n1_clone) * &*n2, arena)) // mul_i
}
(Number::Integer(n1), Number::Float(OrderedFloat(n2)))
| (Number::Float(OrderedFloat(n2)), Number::Integer(n1)) => {
@@ -255,7 +265,8 @@ pub(crate) fn mul(lhs: Number, rhs: Number, arena: &mut Arena) -> Result<Number,
}
(Number::Integer(n1), Number::Rational(n2))
| (Number::Rational(n2), Number::Integer(n1)) => {
Ok(Number::arena_from(Rational::from(&*n1) * &*n2, arena))
let n1_clone: Integer = (*n1).clone();
Ok(Number::arena_from(Rational::from(n1_clone) * &*n2, arena))
}
(Number::Rational(n1), Number::Float(OrderedFloat(n2)))
| (Number::Float(OrderedFloat(n2)), Number::Rational(n1)) => {
@@ -265,7 +276,8 @@ pub(crate) fn mul(lhs: Number, rhs: Number, arena: &mut Arena) -> Result<Number,
Ok(Number::Float(mul_f(f1, f2)?))
}
(Number::Rational(r1), Number::Rational(r2)) => {
Ok(Number::arena_from(Rational::from(&*r1) * &*r2, arena))
let r1_clone: Rational = (*r1).clone();
Ok(Number::arena_from(Rational::from(r1_clone) * &*r2, arena))
}
}
}
@@ -338,7 +350,7 @@ pub(crate) fn int_pow(n1: Number, n2: Number, arena: &mut Arena) -> Result<Numbe
(Number::Fixnum(n1), Number::Integer(n2)) => {
let n1_i = n1.get_num();
if !(n1_i == 1 || n1_i == 0 || n1_i == -1) && &*n2 < &0 {
if !(n1_i == 1 || n1_i == 0 || n1_i == -1) && &*n2 < &Integer::from(0) {
let n = Number::Fixnum(n1);
Err(numerical_type_error(ValidType::Float, n, stub_gen))
} else {
@@ -349,7 +361,11 @@ pub(crate) fn int_pow(n1: Number, n2: Number, arena: &mut Arena) -> Result<Numbe
(Number::Integer(n1), Number::Fixnum(n2)) => {
let n2_i = n2.get_num();
if !(&*n1 == &1 || &*n1 == &0 || &*n1 == &-1) && n2_i < 0 {
if !(&*n1 == &Integer::from(1)
|| &*n1 == &Integer::from(0)
|| &*n1 == &Integer::from(-1))
&& n2_i < 0
{
let n = Number::Integer(n1);
Err(numerical_type_error(ValidType::Float, n, stub_gen))
} else {
@@ -358,7 +374,11 @@ pub(crate) fn int_pow(n1: Number, n2: Number, arena: &mut Arena) -> Result<Numbe
}
}
(Number::Integer(n1), Number::Integer(n2)) => {
if !(&*n1 == &1 || &*n1 == &0 || &*n1 == &-1) && &*n2 < &0 {
if !(&*n1 == &Integer::from(1)
|| &*n1 == &Integer::from(0)
|| &*n1 == &Integer::from(-1))
&& &*n2 < &Integer::from(0)
{
let n = Number::Integer(n1);
Err(numerical_type_error(ValidType::Float, n, stub_gen))
} else {
@@ -435,14 +455,14 @@ pub(crate) fn max(n1: Number, n2: Number) -> Result<Number, MachineStubGen> {
}
}
(Number::Fixnum(n1), Number::Integer(n2)) => {
if &*n2 > &n1.get_num() {
if (&*n2).num_gt(&n1.get_num()) {
Ok(Number::Integer(n2))
} else {
Ok(Number::Fixnum(n1))
}
}
(Number::Integer(n1), Number::Fixnum(n2)) => {
if &*n1 > &n2.get_num() {
if (&*n1).num_gt(&n2.get_num()) {
Ok(Number::Integer(n1))
} else {
Ok(Number::Fixnum(n2))
@@ -479,14 +499,14 @@ pub(crate) fn min(n1: Number, n2: Number) -> Result<Number, MachineStubGen> {
}
}
(Number::Fixnum(n1), Number::Integer(n2)) => {
if &*n2 < &n1.get_num() {
if (&*n2).num_lt(&n1.get_num()) {
Ok(Number::Integer(n2))
} else {
Ok(Number::Fixnum(n1))
}
}
(Number::Integer(n1), Number::Fixnum(n2)) => {
if &*n1 < &n2.get_num() {
if (&*n1).num_lt(&n2.get_num()) {
Ok(Number::Integer(n1))
} else {
Ok(Number::Fixnum(n2))
@@ -521,7 +541,7 @@ pub fn rational_from_number(
match n {
Number::Fixnum(n) => Ok(arena_alloc!(Rational::from(n.get_num()), arena)),
Number::Rational(r) => Ok(r),
Number::Float(OrderedFloat(f)) => match Rational::from_f64(f) {
Number::Float(OrderedFloat(f)) => match Rational::simplest_from_f64(f) {
Some(r) => Ok(arena_alloc!(r, arena)),
None => Err(Box::new(move |machine_st| {
let instantiation_error = machine_st.instantiation_error();
@@ -530,7 +550,10 @@ pub fn rational_from_number(
machine_st.error_form(instantiation_error, stub)
})),
},
Number::Integer(n) => Ok(arena_alloc!(Rational::from(&*n), arena)),
Number::Integer(n) => {
let n_clone: Integer = (*n).clone();
Ok(arena_alloc!(Rational::from(n_clone), arena))
}
}
}
@@ -538,7 +561,7 @@ pub(crate) fn rdiv(
r1: TypedArenaPtr<Rational>,
r2: TypedArenaPtr<Rational>,
) -> Result<Rational, MachineStubGen> {
if &*r2 == &0 {
if r2.is_zero() {
let stub_gen = || {
let rdiv_atom = atom!("rdiv");
functor_stub(rdiv_atom, 2)
@@ -572,7 +595,7 @@ pub(crate) fn idiv(n1: Number, n2: Number, arena: &mut Arena) -> Result<Number,
}
}
(Number::Fixnum(n1), Number::Integer(n2)) => {
if &*n2 == &0 {
if n2.is_zero() {
Err(zero_divisor_eval_error(stub_gen))
} else {
Ok(Number::arena_from(Integer::from(n1) / &*n2, arena))
@@ -586,13 +609,10 @@ pub(crate) fn idiv(n1: Number, n2: Number, arena: &mut Arena) -> Result<Number,
}
}
(Number::Integer(n1), Number::Integer(n2)) => {
if &*n2 == &0 {
if n2.is_zero() {
Err(zero_divisor_eval_error(stub_gen))
} else {
Ok(Number::arena_from(
<(Integer, Integer)>::from(n1.div_rem_ref(&*n2)).0,
arena,
))
Ok(Number::arena_from(&*n1 / &*n2, arena))
}
}
(Number::Fixnum(_), n2) | (Number::Integer(_), n2) => {
@@ -624,6 +644,10 @@ pub(crate) fn shr(n1: Number, n2: Number, arena: &mut Arena) -> Result<Number, M
functor_stub(shr_atom, 2)
};
if n2.is_integer() && n2.is_negative() {
return shl(n1, neg(n2, arena), arena);
}
match (n1, n2) {
(Number::Fixnum(n1), Number::Fixnum(n2)) => {
let n1_i = n1.get_num();
@@ -631,33 +655,44 @@ pub(crate) fn shr(n1: Number, n2: Number, arena: &mut Arena) -> Result<Number, M
let n1 = Integer::from(n1_i);
if let Ok(n2) = u32::try_from(n2_i) {
if let Ok(n2) = usize::try_from(n2_i) {
return Ok(Number::arena_from(n1 >> n2, arena));
} else {
return Ok(Number::arena_from(n1 >> u32::max_value(), arena));
return Ok(Number::arena_from(n1 >> usize::max_value(), arena));
}
}
(Number::Fixnum(n1), Number::Integer(n2)) => {
let n1 = Integer::from(n1.get_num());
match n2.to_u32() {
Some(n2) => Ok(Number::arena_from(n1 >> n2, arena)),
_ => Ok(Number::arena_from(n1 >> u32::max_value(), arena)),
let result: Result<usize, _> = (&*n2).try_into();
match result {
Ok(n2) => {
Ok(Number::arena_from(n1 >> n2, arena))
}
Err(_) => {
Ok(Number::arena_from(n1 >> usize::max_value(), arena))
}
}
}
(Number::Integer(n1), Number::Fixnum(n2)) => match u32::try_from(n2.get_num()) {
(Number::Integer(n1), Number::Fixnum(n2)) => match usize::try_from(n2.get_num()) {
Ok(n2) => Ok(Number::arena_from(Integer::from(&*n1 >> n2), arena)),
_ => Ok(Number::arena_from(
Integer::from(&*n1 >> u32::max_value()),
Integer::from(&*n1 >> usize::max_value()),
arena,
)),
},
(Number::Integer(n1), Number::Integer(n2)) => match n2.to_u32() {
Some(n2) => Ok(Number::arena_from(Integer::from(&*n1 >> n2), arena)),
_ => Ok(Number::arena_from(
Integer::from(&*n1 >> u32::max_value()),
arena,
)),
(Number::Integer(n1), Number::Integer(n2)) => {
let result: Result<usize, _> = (&*n2).try_into();
match result {
Ok(n2) => {
Ok(Number::arena_from(Integer::from(&*n1 >> n2), arena))
}
Err(_) => {
Ok(Number::arena_from(Integer::from(&*n1 >> usize::max_value()), arena))
}
}
},
(Number::Integer(_), n2) => Err(numerical_type_error(ValidType::Integer, n2, stub_gen)),
(Number::Fixnum(_), n2) => Err(numerical_type_error(ValidType::Integer, n2, stub_gen)),
@@ -667,10 +702,14 @@ pub(crate) fn shr(n1: Number, n2: Number, arena: &mut Arena) -> Result<Number, M
pub(crate) fn shl(n1: Number, n2: Number, arena: &mut Arena) -> Result<Number, MachineStubGen> {
let stub_gen = || {
let shl_atom = atom!(">>");
let shl_atom = atom!("<<");
functor_stub(shl_atom, 2)
};
if n2.is_integer() && n2.is_negative() {
return shr(n1, neg(n2, arena), arena);
}
match (n1, n2) {
(Number::Fixnum(n1), Number::Fixnum(n2)) => {
let n1_i = n1.get_num();
@@ -678,33 +717,40 @@ pub(crate) fn shl(n1: Number, n2: Number, arena: &mut Arena) -> Result<Number, M
let n1 = Integer::from(n1_i);
if let Ok(n2) = u32::try_from(n2_i) {
if let Ok(n2) = usize::try_from(n2_i) {
return Ok(Number::arena_from(n1 << n2, arena));
} else {
return Ok(Number::arena_from(n1 << u32::max_value(), arena));
return Ok(Number::arena_from(n1 << usize::max_value(), arena));
}
}
(Number::Fixnum(n1), Number::Integer(n2)) => {
let n1 = Integer::from(n1.get_num());
match n2.to_u32() {
Some(n2) => Ok(Number::arena_from(n1 << n2, arena)),
_ => Ok(Number::arena_from(n1 << u32::max_value(), arena)),
match (&*n2).try_into() as Result<u32, _> {
Ok(n2) => {
let n1: u64 = n1.try_into().unwrap();
Ok(Number::arena_from(n1 << n2, arena))
},
_ => {
Ok(Number::arena_from(n1 << usize::max_value(), arena))
}
}
}
(Number::Integer(n1), Number::Fixnum(n2)) => match u32::try_from(n2.get_num()) {
(Number::Integer(n1), Number::Fixnum(n2)) => match usize::try_from(n2.get_num()) {
Ok(n2) => Ok(Number::arena_from(Integer::from(&*n1 << n2), arena)),
_ => Ok(Number::arena_from(
Integer::from(&*n1 << u32::max_value()),
Integer::from(&*n1 << usize::max_value()),
arena,
)),
},
(Number::Integer(n1), Number::Integer(n2)) => match n2.to_u32() {
Some(n2) => Ok(Number::arena_from(Integer::from(&*n1 << n2), arena)),
_ => Ok(Number::arena_from(
Integer::from(&*n1 << u32::max_value()),
arena,
)),
(Number::Integer(n1), Number::Integer(n2)) => match (&*n2).try_into() as Result<u32, _> {
Ok(n2) => {
let n1: u64 = (&*n1).try_into().unwrap();
Ok(Number::arena_from(Integer::from(n1 << n2), arena))
},
_ => {
Ok(Number::arena_from(Integer::from(&*n1 << usize::max_value()),arena))
}
},
(Number::Integer(_), n2) => Err(numerical_type_error(ValidType::Integer, n2, stub_gen)),
(Number::Fixnum(_), n2) => Err(numerical_type_error(ValidType::Integer, n2, stub_gen)),
@@ -803,6 +849,23 @@ pub(crate) fn modulus(x: Number, y: Number, arena: &mut Arena) -> Result<Number,
functor_stub(mod_atom, 2)
};
fn ibig_rem_floor(n1: &Integer, n2: &Integer) -> Integer {
let ring = ConstDivisor::new(n2.unsigned_abs());
let n1 = n1.clone();
if n2.is_negative() {
let unsigned_result = IBig::from(ring.reduce(n1).residue());
if unsigned_result.is_zero() {
unsigned_result
} else {
unsigned_result + n2
}
} else {
IBig::from(ring.reduce(n1).residue())
}
}
match (x, y) {
(Number::Fixnum(n1), Number::Fixnum(n2)) => {
let n2_i = n2.get_num();
@@ -815,14 +878,11 @@ pub(crate) fn modulus(x: Number, y: Number, arena: &mut Arena) -> Result<Number,
}
}
(Number::Fixnum(n1), Number::Integer(n2)) => {
if &*n2 == &0 {
if n2.is_zero() {
Err(zero_divisor_eval_error(stub_gen))
} else {
let n1 = Integer::from(n1.get_num());
Ok(Number::arena_from(
<(Integer, Integer)>::from(n1.div_rem_floor_ref(&*n2)).1,
arena,
))
Ok(Number::arena_from(ibig_rem_floor(&n1, &*n2), arena))
}
}
(Number::Integer(n1), Number::Fixnum(n2)) => {
@@ -832,20 +892,14 @@ pub(crate) fn modulus(x: Number, y: Number, arena: &mut Arena) -> Result<Number,
Err(zero_divisor_eval_error(stub_gen))
} else {
let n2 = Integer::from(n2_i);
Ok(Number::arena_from(
<(Integer, Integer)>::from(n1.div_rem_floor_ref(&n2)).1,
arena,
))
Ok(Number::arena_from(ibig_rem_floor(&*n1, &n2), arena))
}
}
(Number::Integer(x), Number::Integer(y)) => {
if &*y == &0 {
(Number::Integer(n1), Number::Integer(n2)) => {
if n2.is_zero() {
Err(zero_divisor_eval_error(stub_gen))
} else {
Ok(Number::arena_from(
<(Integer, Integer)>::from(x.div_rem_floor_ref(&*y)).1,
arena,
))
Ok(Number::arena_from(ibig_rem_floor(&*n1, &*n2), arena))
}
}
(Number::Integer(_), n2) | (Number::Fixnum(_), n2) => {
@@ -873,7 +927,7 @@ pub(crate) fn remainder(x: Number, y: Number, arena: &mut Arena) -> Result<Numbe
}
}
(Number::Fixnum(n1), Number::Integer(n2)) => {
if &*n2 == &0 {
if n2.is_zero() {
Err(zero_divisor_eval_error(stub_gen))
} else {
let n1 = Integer::from(n1.get_num());
@@ -891,7 +945,7 @@ pub(crate) fn remainder(x: Number, y: Number, arena: &mut Arena) -> Result<Numbe
}
}
(Number::Integer(n1), Number::Integer(n2)) => {
if &*n2 == &0 {
if n2.is_zero() {
Err(zero_divisor_eval_error(stub_gen))
} else {
Ok(Number::arena_from(Integer::from(&*n1 % &*n2), arena))
@@ -918,18 +972,19 @@ pub(crate) fn gcd(n1: Number, n2: Number, arena: &mut Arena) -> Result<Number, M
if let Some(result) = isize_gcd(n1_i, n2_i) {
Ok(Number::arena_from(result, arena))
} else {
Ok(Number::arena_from(
Integer::from(n1_i).gcd(&Integer::from(n2_i)),
arena,
))
let value: Integer = Integer::from(n1_i).gcd(&Integer::from(n2_i)).into();
Ok(Number::arena_from(value, arena))
}
}
(Number::Fixnum(n1), Number::Integer(n2)) | (Number::Integer(n2), Number::Fixnum(n1)) => {
let n1 = Integer::from(n1.get_num());
Ok(Number::arena_from(Integer::from(n2.gcd_ref(&n1)), arena))
let n2_clone: Integer = (*n2).clone();
Ok(Number::arena_from(Integer::from(n2_clone.gcd(&n1)), arena))
}
(Number::Integer(n1), Number::Integer(n2)) => {
Ok(Number::arena_from(Integer::from(n1.gcd_ref(&n2)), arena))
let n2: isize = (&*n2).try_into().unwrap();
let value: Integer = (&*n1).gcd(&Integer::from(n2)).into();
Ok(Number::arena_from(value, arena))
}
(Number::Float(f), _) | (_, Number::Float(f)) => {
let n = Number::Float(f);
@@ -998,6 +1053,16 @@ pub(crate) fn atan(n1: Number) -> Result<f64, MachineStubGen> {
unary_float_fn_template(n1, |f| f.atan())
}
#[inline]
pub(crate) fn float_fractional_part(n1: Number) -> Result<f64, MachineStubGen> {
unary_float_fn_template(n1, |f| f.fract())
}
#[inline]
pub(crate) fn float_integer_part(n1: Number) -> Result<f64, MachineStubGen> {
unary_float_fn_template(n1, |f| f.trunc())
}
#[inline]
pub(crate) fn sqrt(n1: Number) -> Result<f64, MachineStubGen> {
if n1.is_negative() {
@@ -1069,16 +1134,17 @@ impl MachineState {
pub fn get_number(&mut self, at: &ArithmeticTerm) -> Result<Number, MachineStub> {
match at {
&ArithmeticTerm::Reg(r) => {
let value = self.store(self.deref(self[r]));
let value = self.store(self.deref(self[r]));
match Number::try_from(value) {
Ok(n) => Ok(n),
Err(_) => self.arith_eval_by_metacall(value),
}
}
&ArithmeticTerm::Interm(i) => {
Ok(mem::replace(&mut self.interms[i - 1], Number::Fixnum(Fixnum::build_with(0))))
}
&ArithmeticTerm::Interm(i) => Ok(mem::replace(
&mut self.interms[i - 1],
Number::Fixnum(Fixnum::build_with(0)),
)),
&ArithmeticTerm::Number(n) => Ok(n),
}
}
@@ -1092,13 +1158,17 @@ impl MachineState {
match rational_from_number(n, caller, &mut self.arena) {
Ok(r) => Ok(r),
Err(e_gen) => Err(e_gen(self))
Err(e_gen) => Err(e_gen(self)),
}
}
pub(crate) fn arith_eval_by_metacall(&mut self, value: HeapCellValue) -> Result<Number, MachineStub> {
pub(crate) fn arith_eval_by_metacall(
&mut self,
value: HeapCellValue,
) -> Result<Number, MachineStub> {
let stub_gen = || functor_stub(atom!("is"), 2);
let mut iter = stackful_post_order_iter(&mut self.heap, value);
let mut iter = stackful_post_order_iter::<NonListElider>
(&mut self.heap, &mut self.stack, value);
while let Some(value) = iter.next() {
if value.get_forwarding_bit() {
@@ -1115,7 +1185,7 @@ impl MachineState {
HeapCellValueTag::PStrLoc) => {
(atom!("."), 2)
}
(HeapCellValueTag::AttrVar | HeapCellValueTag::Var) => {
(HeapCellValueTag::AttrVar | HeapCellValueTag::Var | HeapCellValueTag::StackVar) => {
let err = self.instantiation_error();
return Err(self.error_form(err, stub_gen()));
}
@@ -1247,6 +1317,12 @@ impl MachineState {
atom!("tan") => self.interms.push(Number::Float(OrderedFloat(
drop_iter_on_err!(self, iter, tan(a1))
))),
atom!("float_fractional_part") => self.interms.push(Number::Float(OrderedFloat(
drop_iter_on_err!(self, iter, float_fractional_part(a1))
))),
atom!("float_integer_part") => self.interms.push(Number::Float(OrderedFloat(
drop_iter_on_err!(self, iter, float_integer_part(a1))
))),
atom!("sqrt") => self.interms.push(Number::Float(OrderedFloat(
drop_iter_on_err!(self, iter, sqrt(a1))
))),
@@ -1375,26 +1451,11 @@ mod tests {
let mut wam = MachineState::new();
let mut op_dir = default_op_dir();
op_dir.insert(
(atom!("+"), Fixity::In),
OpDesc::build_with(500, YFX as u8),
);
op_dir.insert(
(atom!("-"), Fixity::In),
OpDesc::build_with(500, YFX as u8),
);
op_dir.insert(
(atom!("-"), Fixity::Pre),
OpDesc::build_with(200, FY as u8),
);
op_dir.insert(
(atom!("*"), Fixity::In),
OpDesc::build_with(400, YFX as u8),
);
op_dir.insert(
(atom!("/"), Fixity::In),
OpDesc::build_with(400, YFX as u8),
);
op_dir.insert((atom!("+"), Fixity::In), OpDesc::build_with(500, YFX as u8));
op_dir.insert((atom!("-"), Fixity::In), OpDesc::build_with(500, YFX as u8));
op_dir.insert((atom!("-"), Fixity::Pre), OpDesc::build_with(200, FY as u8));
op_dir.insert((atom!("*"), Fixity::In), OpDesc::build_with(400, YFX as u8));
op_dir.insert((atom!("/"), Fixity::In), OpDesc::build_with(400, YFX as u8));
let term_write_result =
parse_and_write_parsed_term_to_heap(&mut wam, "3 + 4 - 1 + 2.", &op_dir).unwrap();

View File

@@ -1,11 +1,9 @@
:- module('$atts', []).
driver(Vars, Values) :-
iterate(Vars, Values, ListOfListsOfGoalLists),
!,
call_goals(ListOfListsOfGoalLists),
'$reset_attr_var_state',
'$return_from_verify_attr'.
iterate([Var|VarBindings], [Value|ValueBindings], [ListOfGoalLists | ListsCubed]) :-

View File

@@ -33,8 +33,8 @@ impl AttrVarInitializer {
}
#[inline]
pub(super) fn reset(&mut self) {
self.attr_var_queue.clear();
pub(super) fn reset(&mut self, len: usize) {
self.attr_var_queue.truncate(len);
self.bindings.clear();
}
}
@@ -52,6 +52,7 @@ impl MachineState {
self.cp = INSTALL_VERIFY_ATTR_INTERRUPT;
}
debug_assert_eq!(self.heap[h].get_tag(), HeapCellValueTag::AttrVar);
self.attr_var_init.bindings.push((h, addr));
}
@@ -63,10 +64,9 @@ impl MachineState {
.map(|(ref h, _)| attr_var_as_cell!(*h));
let var_list_addr = heap_loc_as_cell!(iter_to_heap_list(&mut self.heap, iter));
let iter = self.attr_var_init.bindings.drain(0..).map(|(_, ref v)| *v);
let value_list_addr = heap_loc_as_cell!(iter_to_heap_list(&mut self.heap, iter));
(var_list_addr, value_list_addr)
}
@@ -118,12 +118,9 @@ impl MachineState {
and_frame[i] = self.registers[i];
}
and_frame[arity + 1] =
fixnum_as_cell!(Fixnum::build_with(self.b0 as i64));
and_frame[arity + 2] =
fixnum_as_cell!(Fixnum::build_with(self.num_of_args as i64));
and_frame[arity + 3] =
fixnum_as_cell!(Fixnum::build_with(self.attr_var_init.cp as i64));
and_frame[arity + 1] = fixnum_as_cell!(Fixnum::build_with(self.b0 as i64));
and_frame[arity + 2] = fixnum_as_cell!(Fixnum::build_with(self.num_of_args as i64));
and_frame[arity + 3] = fixnum_as_cell!(Fixnum::build_with(self.attr_var_init.cp as i64));
self.verify_attributes();
@@ -136,7 +133,8 @@ impl MachineState {
let mut seen_set = IndexSet::new();
let mut seen_vars = vec![];
let mut iter = stackful_preorder_iter(&mut self.heap, cell);
let mut iter = stackful_preorder_iter::<NonListElider>
(&mut self.heap, &mut self.stack, cell);
while let Some(value) = iter.next() {
read_heap_cell!(value,
@@ -147,6 +145,16 @@ impl MachineState {
let value = unmark_cell_bits!(value);
if h != iter.focus().value() as usize {
let deref_value = heap_bound_store(iter.heap, heap_bound_deref(iter.heap, value));
if deref_value.is_compound(iter.heap) {
// a cyclic structure is bound to the attributed variable at h.
// it mustn't be included in seen_vars.
continue;
}
}
seen_vars.push(value);
seen_set.insert(h);
@@ -157,7 +165,7 @@ impl MachineState {
loop {
read_heap_cell!(iter.heap[l],
(HeapCellValueTag::Lis) => {
iter.push_stack(l);
iter.push_stack(IterStackLoc::iterable_loc(l, HeapOrStackTag::Heap));
// l = elem + 1;
break;
}

View File

@@ -1,5 +1,6 @@
use crate::instructions::*;
use fxhash::FxBuildHasher;
use indexmap::IndexSet;
fn capture_offset(line: &Instruction, index: usize, stack: &mut Vec<usize>) -> bool {
@@ -7,38 +8,26 @@ fn capture_offset(line: &Instruction, index: usize, stack: &mut Vec<usize>) -> b
&Instruction::TryMeElse(offset) if offset > 0 => {
stack.push(index + offset);
}
&Instruction::DefaultRetryMeElse(offset) |
&Instruction::RetryMeElse(offset)
&Instruction::DefaultRetryMeElse(offset) | &Instruction::RetryMeElse(offset)
if offset > 0 =>
{
stack.push(index + offset);
}
&Instruction::DynamicElse(_, _, NextOrFail::Next(offset))
if offset > 0 =>
{
&Instruction::DynamicElse(_, _, NextOrFail::Next(offset)) if offset > 0 => {
stack.push(index + offset);
}
&Instruction::DynamicInternalElse(_, _, NextOrFail::Next(offset))
if offset > 0 =>
{
&Instruction::DynamicInternalElse(_, _, NextOrFail::Next(offset)) if offset > 0 => {
stack.push(index + offset);
}
&Instruction::JmpByCall(_, offset, _) => {
stack.push(index + offset);
}
&Instruction::JmpByExecute(_, offset, _) => {
stack.push(index + offset);
return true;
}
&Instruction::Proceed => {
&Instruction::Proceed | &Instruction::JmpByCall(_) => {
return true;
}
&Instruction::RevJmpBy(offset) => {
if offset > 0 {
stack.push(index - offset);
} else {
return true;
}
return true;
}
instr if instr.is_execute() => {
return true;
@@ -55,7 +44,7 @@ fn capture_offset(line: &Instruction, index: usize, stack: &mut Vec<usize>) -> b
*/
pub(crate) fn walk_code(code: &Code, p: usize, mut walker: impl FnMut(&Instruction)) {
let mut stack = vec![p];
let mut visited_indices = IndexSet::new();
let mut visited_indices = IndexSet::with_hasher(FxBuildHasher::default());
while let Some(first_index) = stack.pop() {
if visited_indices.contains(&first_index) {
@@ -73,23 +62,3 @@ pub(crate) fn walk_code(code: &Code, p: usize, mut walker: impl FnMut(&Instructi
}
}
}
/* A function for code walking that might result in modification to
* the code. Otherwise identical to walk_code.
*/
/*
pub(crate) fn walk_code_mut(code: &mut Code, p: usize, mut walker: impl FnMut(&mut Line))
{
let mut queue = VecDeque::from(vec![p]);
while let Some(first_idx) = queue.pop_front() {
let mut last_idx = first_idx;
capture_next_range(code, &mut queue, &mut last_idx);
for instr in &mut code[first_idx .. last_idx + 1] {
walker(instr);
}
}
}
*/

View File

@@ -28,76 +28,20 @@ pub(super) fn bootstrapping_compile(
) -> Result<(), SessionError> {
let (wam_prelude, machine_st) = wam.prelude_view_and_machine_st();
let term_stream = BootstrappingTermStream::from_char_reader(
stream,
machine_st,
listing_src,
);
let term_stream = BootstrappingTermStream::from_char_reader(stream, machine_st, listing_src);
let payload = BootstrappingLoadState(
LoadStatePayload::new(wam_prelude.code.len(), term_stream)
);
let payload =
BootstrappingLoadState(LoadStatePayload::new(wam_prelude.code.len(), term_stream));
let loader: Loader<'_, BootstrappingLoadState> = Loader { payload, wam_prelude };
let loader: Loader<'_, BootstrappingLoadState> = Loader {
payload,
wam_prelude,
};
loader.load()?;
Ok(())
}
// throw errors if declaration or query found.
pub(super) fn compile_relation(
cg: &mut CodeGenerator,
tl: &TopLevel,
) -> Result<Code, CompilationError> {
match tl {
&TopLevel::Query(_) => Err(CompilationError::ExpectedRel),
&TopLevel::Predicate(ref clauses) => cg.compile_predicate(&clauses),
&TopLevel::Fact(ref fact, ..) => cg.compile_fact(fact),
&TopLevel::Rule(ref rule, ..) => cg.compile_rule(rule),
}
}
pub(super) fn compile_appendix(
code: &mut Code,
mut queue: VecDeque<TopLevel>,
jmp_by_locs: Vec<usize>,
non_counted_bt: bool,
atom_tbl: &mut AtomTable,
) -> Result<(), CompilationError> {
let mut jmp_by_locs = VecDeque::from(jmp_by_locs);
while let Some(jmp_by_offset) = jmp_by_locs.pop_front() {
let code_len = code.len();
match &mut code[jmp_by_offset] {
&mut Instruction::JmpByCall(_, ref mut offset, ..) |
&mut Instruction::JmpByExecute(_, ref mut offset, ..) => {
*offset = code_len - jmp_by_offset;
}
_ => {
unreachable!()
}
}
// false because the inner predicate is a one-off, hence not extensible.
let settings = CodeGenSettings {
global_clock_tick: None,
is_extensible: false,
non_counted_bt,
};
let mut cg = CodeGenerator::new(atom_tbl, settings);
let tl = queue.pop_front().unwrap();
let decl_code = compile_relation(&mut cg, &tl)?;
jmp_by_locs.extend(cg.jmp_by_locs.into_iter().map(|offset| offset + code.len()));
code.extend(decl_code.into_iter());
}
Ok(())
}
fn lower_bound_of_target_clause(skeleton: &PredicateSkeleton, target_pos: usize) -> usize {
if target_pos == 0 {
return 0;
@@ -152,8 +96,8 @@ fn derelictize_try_me_else(
retraction_info.push_record(RetractionRecord::ReplacedDynamicElseOffset(index, *o));
Some(mem::replace(o, 0))
}
Instruction::DynamicElse(_, _, NextOrFail::Fail(_)) |
Instruction::DynamicInternalElse(_, _, NextOrFail::Fail(_)) => None,
Instruction::DynamicElse(_, _, NextOrFail::Fail(_))
| Instruction::DynamicInternalElse(_, _, NextOrFail::Fail(_)) => None,
Instruction::TryMeElse(0) => None,
Instruction::TryMeElse(ref mut o) => {
retraction_info.push_record(RetractionRecord::ModifiedTryMeElse(index, *o));
@@ -208,8 +152,8 @@ fn merge_indices(
fn find_outer_choice_instr(code: &Code, mut index: usize) -> usize {
loop {
match &code[index] {
Instruction::DynamicElse(_, _, NextOrFail::Next(i)) |
Instruction::DynamicInternalElse(_, _, NextOrFail::Next(i))
Instruction::DynamicElse(_, _, NextOrFail::Next(i))
| Instruction::DynamicInternalElse(_, _, NextOrFail::Next(i))
if *i > 0 =>
{
index += i;
@@ -224,42 +168,37 @@ fn find_outer_choice_instr(code: &Code, mut index: usize) -> usize {
fn find_inner_choice_instr(code: &Code, mut index: usize, index_loc: usize) -> usize {
loop {
match &code[index] {
Instruction::TryMeElse(o) |
Instruction::RetryMeElse(o) => {
Instruction::TryMeElse(o) | Instruction::RetryMeElse(o) => {
if *o > 0 {
return index;
} else {
index = index_loc;
}
}
&Instruction::DynamicElse(_, _, next_or_fail) => {
match next_or_fail {
NextOrFail::Next(i) => {
if i == 0 {
index = index_loc;
} else {
return index;
}
}
NextOrFail::Fail(_) => {
&Instruction::DynamicElse(_, _, next_or_fail) => match next_or_fail {
NextOrFail::Next(i) => {
if i == 0 {
index = index_loc;
}
}
}
&Instruction::DynamicInternalElse(_, _, next_or_fail) => {
match next_or_fail {
NextOrFail::Next(i) => {
if i == 0 {
index = index_loc;
} else {
return index;
}
}
NextOrFail::Fail(_) => {
} else {
return index;
}
}
}
NextOrFail::Fail(_) => {
index = index_loc;
}
},
&Instruction::DynamicInternalElse(_, _, next_or_fail) => match next_or_fail {
NextOrFail::Next(i) => {
if i == 0 {
index = index_loc;
} else {
return index;
}
}
NextOrFail::Fail(_) => {
return index;
}
},
Instruction::TrustMe(_) => {
return index;
}
@@ -269,11 +208,7 @@ fn find_inner_choice_instr(code: &Code, mut index: usize, index_loc: usize) -> u
index += v;
}
IndexingCodePtr::DynamicExternal(v) => match &code[index + v] {
&Instruction::DynamicInternalElse(
_,
_,
NextOrFail::Next(0),
) => {
&Instruction::DynamicInternalElse(_, _, NextOrFail::Next(0)) => {
return index + v;
}
_ => {
@@ -363,8 +298,7 @@ fn merge_indexed_subsequences(
code[inner_try_me_else_loc] = Instruction::TrustMe(o);
}
_ => {
code[inner_try_me_else_loc] =
Instruction::RetryMeElse(o);
code[inner_try_me_else_loc] = Instruction::RetryMeElse(o);
}
},
}
@@ -430,7 +364,9 @@ fn delete_from_skeleton(
}
if skeleton.core.is_dynamic {
skeleton.core.add_retracted_dynamic_clause_info(clause_index_info);
skeleton
.core
.add_retracted_dynamic_clause_info(clause_index_info);
retraction_info.push_record(RetractionRecord::RemovedDynamicSkeletonClause(
compilation_target,
@@ -463,8 +399,8 @@ fn blunt_leading_choice_instr(
code[instr_loc] = Instruction::TryMeElse(*o);
return instr_loc;
}
Instruction::DynamicElse(_, _, NextOrFail::Next(_)) |
Instruction::DynamicInternalElse(_, _, NextOrFail::Next(_)) => {
Instruction::DynamicElse(_, _, NextOrFail::Next(_))
| Instruction::DynamicInternalElse(_, _, NextOrFail::Next(_)) => {
return instr_loc;
}
&mut Instruction::DynamicElse(b, d, NextOrFail::Fail(o)) => {
@@ -476,26 +412,19 @@ fn blunt_leading_choice_instr(
code[instr_loc] = Instruction::DynamicElse(b, d, NextOrFail::Next(0));
return instr_loc;
}
&mut Instruction::DynamicInternalElse(
b,
d,
NextOrFail::Fail(o),
) => {
&mut Instruction::DynamicInternalElse(b, d, NextOrFail::Fail(o)) => {
retraction_info.push_record(RetractionRecord::AppendedNextOrFail(
instr_loc,
NextOrFail::Fail(o),
));
code[instr_loc] = Instruction::DynamicInternalElse(
b,
d,
NextOrFail::Next(0),
);
code[instr_loc] = Instruction::DynamicInternalElse(b, d, NextOrFail::Next(0));
return instr_loc;
}
Instruction::TrustMe(o) => {
retraction_info.push_record(RetractionRecord::AppendedTrustMe(instr_loc, *o, false));
retraction_info
.push_record(RetractionRecord::AppendedTrustMe(instr_loc, *o, false));
code[instr_loc] = Instruction::TryMeElse(0);
return instr_loc + 1;
@@ -535,9 +464,9 @@ fn set_switch_var_offset_to_choice_instr(
};
match &code[index_loc + v] {
Instruction::TryMeElse(_) |
Instruction::DynamicElse(..) |
Instruction::DynamicInternalElse(..) => {}
Instruction::TryMeElse(_)
| Instruction::DynamicElse(..)
| Instruction::DynamicInternalElse(..) => {}
_ => {
set_switch_var_offset(code, index_loc, offset, retraction_info);
}
@@ -577,9 +506,8 @@ fn internalize_choice_instr_at(
retraction_info: &mut RetractionInfo,
) {
match &mut code[instr_loc] {
Instruction::DynamicElse(_, _, NextOrFail::Fail(_)) |
Instruction::DynamicInternalElse(_, _, NextOrFail::Fail(_)) => {
}
Instruction::DynamicElse(_, _, NextOrFail::Fail(_))
| Instruction::DynamicInternalElse(_, _, NextOrFail::Fail(_)) => {}
Instruction::DynamicElse(_, _, ref mut o @ NextOrFail::Next(0)) => {
retraction_info.push_record(RetractionRecord::ReplacedDynamicElseOffset(instr_loc, 0));
*o = NextOrFail::Fail(0);
@@ -608,18 +536,10 @@ fn internalize_choice_instr_at(
match &mut code[instr_loc + o] {
Instruction::RevJmpBy(p) if *p == 0 => {
code[instr_loc] = Instruction::DynamicInternalElse(
b,
d,
NextOrFail::Fail(o),
);
code[instr_loc] = Instruction::DynamicInternalElse(b, d, NextOrFail::Fail(o));
}
_ => {
code[instr_loc] = Instruction::DynamicInternalElse(
b,
d,
NextOrFail::Next(o),
);
code[instr_loc] = Instruction::DynamicInternalElse(b, d, NextOrFail::Next(o));
}
}
}
@@ -663,23 +583,20 @@ fn thread_choice_instr_at_to(
*o = target_loc - instr_loc;
return;
}
Instruction::DynamicElse(_, _, NextOrFail::Next(ref mut o)) |
Instruction::DynamicInternalElse(
_,
_,
NextOrFail::Next(ref mut o),
) if target_loc >= instr_loc => {
Instruction::DynamicElse(_, _, NextOrFail::Next(ref mut o))
| Instruction::DynamicInternalElse(_, _, NextOrFail::Next(ref mut o))
if target_loc >= instr_loc =>
{
retraction_info
.push_record(RetractionRecord::ReplacedDynamicElseOffset(instr_loc, *o));
*o = target_loc - instr_loc;
return;
}
Instruction::DynamicElse(_, _, NextOrFail::Next(o)) |
Instruction::DynamicInternalElse(_, _, NextOrFail::Next(o)) => {
Instruction::DynamicElse(_, _, NextOrFail::Next(o))
| Instruction::DynamicInternalElse(_, _, NextOrFail::Next(o)) => {
instr_loc += *o;
}
Instruction::TryMeElse(o)
| Instruction::RetryMeElse(o) => {
Instruction::TryMeElse(o) | Instruction::RetryMeElse(o) => {
instr_loc += *o;
}
Instruction::RevJmpBy(ref mut o) if instr_loc >= target_loc => {
@@ -696,7 +613,8 @@ fn thread_choice_instr_at_to(
{
retraction_info.push_record(RetractionRecord::AppendedNextOrFail(instr_loc, *fail));
code[instr_loc] = instr!("dynamic_else",
code[instr_loc] = instr!(
"dynamic_else",
birth,
death,
NextOrFail::Next(target_loc - instr_loc)
@@ -707,14 +625,13 @@ fn thread_choice_instr_at_to(
Instruction::DynamicElse(_, _, NextOrFail::Fail(o)) if *o > 0 => {
instr_loc += *o;
}
&mut Instruction::DynamicInternalElse(
birth,
death,
ref mut fail,
) if target_loc >= instr_loc => {
&mut Instruction::DynamicInternalElse(birth, death, ref mut fail)
if target_loc >= instr_loc =>
{
retraction_info.push_record(RetractionRecord::AppendedNextOrFail(instr_loc, *fail));
code[instr_loc] = instr!("dynamic_internal_else",
code[instr_loc] = instr!(
"dynamic_internal_else",
birth,
death,
NextOrFail::Next(target_loc - instr_loc)
@@ -722,9 +639,7 @@ fn thread_choice_instr_at_to(
return;
}
Instruction::DynamicInternalElse(_, _, NextOrFail::Fail(o))
if *o > 0 =>
{
Instruction::DynamicInternalElse(_, _, NextOrFail::Fail(o)) if *o > 0 => {
instr_loc += *o;
}
Instruction::TrustMe(ref mut o) if target_loc >= instr_loc => {
@@ -765,33 +680,31 @@ fn remove_non_leading_clause(
None
}
Instruction::TrustMe(_) => {
match &mut code[preceding_choice_instr_loc] {
Instruction::RetryMeElse(o) => {
retraction_info.push_record(RetractionRecord::ModifiedRetryMeElse(
preceding_choice_instr_loc,
*o,
));
Instruction::TrustMe(_) => match &mut code[preceding_choice_instr_loc] {
Instruction::RetryMeElse(o) => {
retraction_info.push_record(RetractionRecord::ModifiedRetryMeElse(
preceding_choice_instr_loc,
*o,
));
code[preceding_choice_instr_loc] = Instruction::TrustMe(0);
code[preceding_choice_instr_loc] = Instruction::TrustMe(0);
None
}
Instruction::TryMeElse(ref mut o) => {
retraction_info.push_record(RetractionRecord::ModifiedTryMeElse(
preceding_choice_instr_loc,
*o,
));
*o = 0;
Some(IndexPtr::index(preceding_choice_instr_loc + 1))
}
_ => {
unreachable!();
}
None
}
}
Instruction::TryMeElse(ref mut o) => {
retraction_info.push_record(RetractionRecord::ModifiedTryMeElse(
preceding_choice_instr_loc,
*o,
));
*o = 0;
Some(IndexPtr::index(preceding_choice_instr_loc + 1))
}
_ => {
unreachable!();
}
},
_ => {
unreachable!();
}
@@ -1042,11 +955,7 @@ fn prepend_compiled_clause(
Instruction::TryMeElse(ref mut o) if *o == 0 => {
*o = prepend_queue_len - 2;
}
Instruction::DynamicInternalElse(
_,
_,
ref mut o @ NextOrFail::Next(0),
) => {
Instruction::DynamicInternalElse(_, _, ref mut o @ NextOrFail::Next(0)) => {
*o = NextOrFail::Fail(prepend_queue_len - 2);
}
_ => {
@@ -1312,7 +1221,11 @@ fn print_overwrite_warning(
_ => {}
}
println!("Warning: overwriting {}/{}", key.0.as_str(), key.1);
println!(
"Warning: overwriting {}/{} because the clauses are discontiguous",
key.0.as_str(),
key.1
);
}
impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
@@ -1324,8 +1237,9 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
if let Some(path_str) = load_context.path.to_str() {
if !path_str.is_empty() {
return Some(LS::machine_st(&mut self.payload).atom_tbl.build_with(
path_str
return Some(AtomTable::build_with(
&LS::machine_st(&mut self.payload).atom_tbl,
path_str,
));
}
}
@@ -1342,22 +1256,11 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
let mut preprocessor = Preprocessor::new(settings);
let clause = self.try_term_to_tl(term, &mut preprocessor)?;
let queue = preprocessor.parse_queue(self)?;
// let queue = preprocessor.parse_queue(self)?;
let mut cg = CodeGenerator::new(
&mut LS::machine_st(&mut self.payload).atom_tbl,
settings,
);
let mut cg = CodeGenerator::new(&LS::machine_st(&mut self.payload).atom_tbl, settings);
let mut clause_code = cg.compile_predicate(&vec![clause])?;
compile_appendix(
&mut clause_code,
queue,
cg.jmp_by_locs,
settings.non_counted_bt,
cg.atom_tbl,
)?;
let clause_code = cg.compile_predicate(vec![clause])?;
Ok(StandaloneCompileResult {
clause_code,
@@ -1385,22 +1288,9 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
clauses.push(self.try_term_to_tl(term, &mut preprocessor)?);
}
let queue = preprocessor.parse_queue(self)?;
let mut cg = CodeGenerator::new(&LS::machine_st(&mut self.payload).atom_tbl, settings);
let mut cg = CodeGenerator::new(
&mut LS::machine_st(&mut self.payload).atom_tbl,
settings,
);
let mut code = cg.compile_predicate(&clauses)?;
compile_appendix(
&mut code,
queue,
cg.jmp_by_locs,
settings.non_counted_bt,
cg.atom_tbl,
)?;
let mut code = cg.compile_predicate(clauses)?;
if settings.is_extensible {
let mut clause_clause_locs = VecDeque::new();
@@ -1433,26 +1323,23 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
.clause_clause_locs
.extend(&clause_clause_locs.make_contiguous()[0..]);
self.payload.retraction_info
.push_record(RetractionRecord::SkeletonClauseTruncateBack(
self.payload.retraction_info.push_record(
RetractionRecord::SkeletonClauseTruncateBack(
predicates.compilation_target,
key,
skeleton_clause_len,
));
),
);
}
None => {
cg.skeleton
.core
.clause_clause_locs
.extend(&clause_clause_locs.make_contiguous()[0..]);
.core
.clause_clause_locs
.extend(&clause_clause_locs.make_contiguous()[0..]);
let skeleton = cg.skeleton;
self.add_extensible_predicate(
key,
skeleton,
predicates.compilation_target,
);
self.add_extensible_predicate(key, skeleton, predicates.compilation_target);
}
};
@@ -1522,11 +1409,7 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
let mut skeleton = LocalPredicateSkeleton::new();
skeleton.clause_clause_locs = clause_clause_locs;
self.add_local_extensible_predicate(
*compilation_target,
*key,
skeleton,
);
self.add_local_extensible_predicate(*compilation_target, *key, skeleton);
}
}
}
@@ -1562,11 +1445,7 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
let mut skeleton = LocalPredicateSkeleton::new();
skeleton.clause_clause_locs.push_front(code_len);
self.add_local_extensible_predicate(
*compilation_target,
*key,
skeleton,
);
self.add_local_extensible_predicate(*compilation_target, *key, skeleton);
}
}
}
@@ -1602,11 +1481,7 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
let mut skeleton = LocalPredicateSkeleton::new();
skeleton.clause_clause_locs.push_back(code_len);
self.add_local_extensible_predicate(
*compilation_target,
*key,
skeleton,
);
self.add_local_extensible_predicate(*compilation_target, *key, skeleton);
}
}
}
@@ -1678,7 +1553,8 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
skeleton.core.clause_clause_locs.push_back(code_len);
self.payload.retraction_info
self.payload
.retraction_info
.push_record(RetractionRecord::SkeletonClausePopBack(
compilation_target,
key,
@@ -1696,8 +1572,7 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
self.push_back_to_local_predicate_skeleton(&compilation_target, &key, code_len);
let code_index =
self.get_or_insert_code_index(key, compilation_target);
let code_index = self.get_or_insert_code_index(key, compilation_target);
if let Some(new_code_ptr) = result {
set_code_index(
@@ -1718,7 +1593,8 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
skeleton.core.clause_clause_locs.push_front(code_len);
skeleton.core.clause_assert_margin += 1;
self.payload.retraction_info
self.payload
.retraction_info
.push_record(RetractionRecord::SkeletonClausePopFront(
compilation_target,
key,
@@ -1738,8 +1614,7 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
self.push_front_to_local_predicate_skeleton(&compilation_target, &key, code_len);
let code_index =
self.get_or_insert_code_index(key, compilation_target);
let code_index = self.get_or_insert_code_index(key, compilation_target);
set_code_index(
&mut self.payload.retraction_info,
@@ -1770,19 +1645,17 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
.opt_arg_index_key
.switch_on_term_loc()
{
Some(index_loc) => {
find_inner_choice_instr(
&self.wam_prelude.code,
skeleton.clauses[target_pos].clause_start,
index_loc,
)
}
Some(index_loc) => find_inner_choice_instr(
&self.wam_prelude.code,
skeleton.clauses[target_pos].clause_start,
index_loc,
),
None => skeleton.clauses[target_pos].clause_start,
};
match &mut self.wam_prelude.code[clause_loc] {
Instruction::DynamicElse(_, ref mut d, _) |
Instruction::DynamicInternalElse(_, ref mut d, _) => {
Instruction::DynamicElse(_, ref mut d, _)
| Instruction::DynamicInternalElse(_, ref mut d, _) => {
*d = Death::Finite(LS::machine_st(&mut self.payload).global_clock);
}
_ => unreachable!(),
@@ -1869,7 +1742,13 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
skeleton.clauses[target_pos + 1].clause_start =
skeleton.clauses[target_pos].clause_start;
let index_ptr_opt = if target_pos == 0 {
let update_code_index = target_pos == 0
&& skeleton.clauses[target_pos + 1]
.opt_arg_index_key
.switch_on_term_loc()
.is_none();
let index_ptr_opt = if update_code_index {
Some(IndexPtr::index(clause_loc))
} else {
None
@@ -2030,7 +1909,8 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
index_loc,
);
let lower_bound_clause_start = skeleton.clauses[lower_bound].clause_start;
let lower_bound_clause_start =
skeleton.clauses[lower_bound].clause_start;
let preceding_choice_instr_loc;
match &mut code[clause_start] {
@@ -2159,13 +2039,8 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
clause_clauses: ClauseIter,
append_or_prepend: AppendOrPrepend,
) -> Result<(), SessionError> {
let clause_predicates = clause_clauses.map(|(head, body)| {
Term::Clause(
Cell::default(),
atom!("$clause"),
vec![head, body],
)
});
let clause_predicates = clause_clauses
.map(|(head, body)| Term::Clause(Cell::default(), atom!("$clause"), vec![head, body]));
let clause_clause_compilation_target = match compilation_target {
CompilationTarget::User => CompilationTarget::Module(atom!("builtins")),
@@ -2198,21 +2073,21 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
.cloned()
.collect()
}
Some(skeleton) => {
skeleton.core.clause_clause_locs.make_contiguous()[0..num_clause_predicates]
.iter()
.cloned()
.collect()
}
Some(skeleton) => skeleton.core.clause_clause_locs.make_contiguous()
[0..num_clause_predicates]
.iter()
.cloned()
.collect(),
None => {
unreachable!()
}
};
match self.wam_prelude.indices.get_predicate_skeleton_mut(
&clause_clause_compilation_target,
&(atom!("$clause"), 2),
) {
match self
.wam_prelude
.indices
.get_predicate_skeleton_mut(&clause_clause_compilation_target, &(atom!("$clause"), 2))
{
Some(skeleton) if append_or_prepend.is_append() => {
for _ in 0..num_clause_predicates {
skeleton.core.clause_clause_locs.pop_back();
@@ -2274,16 +2149,19 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
.ok_or(SessionError::NamelessEntry)?;
let listing_src_file_name = self.listing_src_file_name();
// payload_compilation_target describes the compilation context,
// e.g. compiling
//
// table_wrapper:tabled(get_node(A), b).
//
// without a module declaration means self.payload.compilation_target
// is CompilationTarget::User while self.payload.predicates.compilation_target
// is CompilationTarget::Module(atom!("table_wrapper")).
let payload_compilation_target = self.payload.compilation_target;
let mut predicate_info = self
.wam_prelude
.indices
.get_predicate_skeleton(&self.payload.predicates.compilation_target, &key)
.map(|skeleton| skeleton.predicate_info())
.unwrap_or_default();
let local_predicate_info = self
let mut local_predicate_info = self
.wam_prelude
.indices
.get_local_predicate_skeleton(
@@ -2295,56 +2173,63 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
.map(|skeleton| skeleton.predicate_info())
.unwrap_or_default();
if local_predicate_info.must_retract_local_clauses() {
let mut predicate_info = self
.wam_prelude
.indices
.get_predicate_skeleton(&self.payload.predicates.compilation_target, &key)
.map(|skeleton| skeleton.predicate_info())
.unwrap_or_default();
let is_cross_module_clause =
payload_compilation_target != self.payload.predicates.compilation_target;
local_predicate_info.is_discontiguous = predicate_info.is_discontiguous;
if local_predicate_info.must_retract_local_clauses(is_cross_module_clause) {
self.retract_local_clauses(&key, predicate_info.is_dynamic);
}
let do_incremental_compile =
if payload_compilation_target == self.payload.predicates.compilation_target {
predicate_info.compile_incrementally()
} else {
local_predicate_info.is_multifile && predicate_info.compile_incrementally()
};
let predicates_len = self.payload.predicates.len();
let non_counted_bt = self.payload.non_counted_bt_preds.contains(&key);
if do_incremental_compile {
if predicate_info.compile_incrementally() {
let predicates = self.payload.predicates.take();
for term in predicates.predicates {
self.incremental_compile_clause(
key,
term,
payload_compilation_target,
self.payload.predicates.compilation_target,
non_counted_bt,
AppendOrPrepend::Append,
)?;
}
} else {
if payload_compilation_target != self.payload.predicates.compilation_target {
if is_cross_module_clause {
if !local_predicate_info.is_extensible {
if predicate_info.is_multifile {
println!(
"Warning: overwriting multifile predicate {}:{}/{} because \
it was not locally declared multifile.",
self.payload.predicates.compilation_target, key.0.as_str(), key.1
self.payload.predicates.compilation_target,
key.0.as_str(),
key.1
);
}
if let Some(skeleton) = self
.wam_prelude
.indices
.remove_predicate_skeleton(&self.payload.predicates.compilation_target, &key)
{
if let Some(skeleton) = self.wam_prelude.indices.remove_predicate_skeleton(
&self.payload.predicates.compilation_target,
&key,
) {
let compilation_target = self.payload.predicates.compilation_target;
if predicate_info.is_dynamic {
let clause_clause_compilation_target =
match self.payload.predicates.compilation_target {
CompilationTarget::User => {
CompilationTarget::Module(atom!("builtins"))
}
module => module,
};
let clause_clause_compilation_target = match compilation_target {
CompilationTarget::User => {
CompilationTarget::Module(atom!("builtins"))
}
module => module,
};
self.retract_local_clauses_by_locs(
clause_clause_compilation_target,
@@ -2357,11 +2242,7 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
}
self.payload.retraction_info.push_record(
RetractionRecord::RemovedSkeleton(
payload_compilation_target,
key,
skeleton,
),
RetractionRecord::RemovedSkeleton(compilation_target, key, skeleton),
);
}
}
@@ -2384,9 +2265,7 @@ 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)
.clone();
let code_index = module.code_dir.entry(key).or_insert(code_index).clone();
set_code_index(
&mut self.payload.retraction_info,
@@ -2405,13 +2284,17 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
LS::machine_st(&mut self.payload).global_clock += 1;
let clause_clauses_len = self.payload.clause_clauses.len();
let clauses_vec: Vec<_> = self.payload
.clause_clauses.drain(0..std::cmp::min(predicates_len, clause_clauses_len))
let clauses_vec: Vec<_> = self
.payload
.clause_clauses
.drain(0..std::cmp::min(predicates_len, clause_clauses_len))
.collect();
let compilation_target = self.payload.predicates.compilation_target;
self.compile_clause_clauses(
key,
payload_compilation_target,
compilation_target,
clauses_vec.into_iter(),
AppendOrPrepend::Append,
)?;
@@ -2428,10 +2311,7 @@ impl Machine {
module_name: HeapCellValue,
key: PredicateKey,
) -> CodeIndex {
let mut loader: Loader<'_, InlineLoadState<'_>> = Loader::new(
self,
InlineTermStream {},
);
let mut loader: Loader<'_, InlineLoadState<'_>> = Loader::new(self, InlineTermStream {});
let module_name = if module_name.get_tag() == HeapCellValueTag::Atom {
cell_as_atom!(module_name)
@@ -2448,12 +2328,10 @@ impl Machine {
vars: &[Term],
) -> Result<(), SessionError> {
let mut compile = || {
let mut loader: Loader<'_, InlineLoadState<'_>> = Loader::new(
self,
InlineTermStream {},
);
let mut loader: Loader<'_, InlineLoadState<'_>> =
Loader::new(self, InlineTermStream {});
let term = loader.read_term_from_heap(term_loc)?;
let term = loader.read_term_from_heap(term_loc);
let clause = build_rule_body(vars, term);
let settings = CodeGenSettings {

32
src/machine/config.rs Normal file
View File

@@ -0,0 +1,32 @@
pub struct MachineConfig {
pub streams: StreamConfig,
pub toplevel: &'static str,
}
pub enum StreamConfig {
Stdio,
Memory,
}
impl Default for MachineConfig {
fn default() -> Self {
MachineConfig {
streams: StreamConfig::Stdio,
toplevel: include_str!("../toplevel.pl"),
}
}
}
impl MachineConfig {
pub fn in_memory() -> Self {
MachineConfig {
streams: StreamConfig::Memory,
..Default::default()
}
}
pub fn with_toplevel(mut self, toplevel: &'static str) -> Self {
self.toplevel = toplevel;
self
}
}

View File

@@ -28,7 +28,10 @@ pub(crate) fn copy_term<T: CopierTarget>(
attr_var_policy: AttrVarPolicy,
) {
let mut copy_term_state = CopyTermState::new(target, attr_var_policy);
copy_term_state.copy_term_impl(addr);
copy_term_state.copy_attr_var_lists();
copy_term_state.unwind_trail();
}
#[derive(Debug)]
@@ -38,6 +41,7 @@ struct CopyTermState<T: CopierTarget> {
old_h: usize,
target: T,
attr_var_policy: AttrVarPolicy,
attr_var_list_locs: Vec<(usize, HeapCellValue)>,
}
impl<T: CopierTarget> CopyTermState<T> {
@@ -48,6 +52,7 @@ impl<T: CopierTarget> CopyTermState<T> {
old_h: target.threshold(),
target,
attr_var_policy,
attr_var_list_locs: vec![],
}
}
@@ -167,6 +172,51 @@ impl<T: CopierTarget> CopyTermState<T> {
self.trail.push((Ref::heap_cell(pstr_loc), trail_item));
}
fn copy_attr_var_lists(&mut self) {
while !self.attr_var_list_locs.is_empty() {
let iter = mem::replace(&mut self.attr_var_list_locs, vec![]);
for (threshold, list_loc) in iter {
self.target[threshold] = list_loc_as_cell!(self.target.threshold());
self.copy_attr_var_list(list_loc);
}
}
}
/*
* Attributed variable attribute lists adhere to a particular
* structure which is ensured by this function and not at all by
* the vanilla copier.
*/
fn copy_attr_var_list(&mut self, mut list_addr: HeapCellValue) {
while let HeapCellValueTag::Lis = list_addr.get_tag() {
let threshold = self.target.threshold();
let heap_loc = list_addr.get_value() as usize;
let str_loc = self.target[heap_loc].get_value() as usize;
self.target.push(heap_loc_as_cell!(threshold + 2));
self.target.push(heap_loc_as_cell!(threshold + 1));
read_heap_cell!(self.target[str_loc],
(HeapCellValueTag::Atom) => {
self.target.push(self.target[str_loc]);
}
(HeapCellValueTag::Str) => {
self.copy_term_impl(self.target[str_loc]);
}
_ => {
unreachable!();
}
);
list_addr = self.target[heap_loc + 1];
if HeapCellValueTag::Lis == list_addr.get_tag() {
self.target[threshold + 1] = list_loc_as_cell!(self.target.threshold());
}
}
}
fn reinstantiate_var(&mut self, addr: HeapCellValue, frontier: usize) {
read_heap_cell!(addr,
(HeapCellValueTag::Var, h) => {
@@ -195,9 +245,15 @@ impl<T: CopierTarget> CopyTermState<T> {
if let AttrVarPolicy::DeepCopy = self.attr_var_policy {
self.target.push(attr_var_as_cell!(threshold));
self.target.push(heap_loc_as_cell!(threshold + 1));
let list_val = self.target[h + 1];
self.target.push(list_val);
let old_list_link = self.target[h + 1];
self.trail.push((Ref::heap_cell(h + 1), old_list_link));
self.target[h + 1] = heap_loc_as_cell!(threshold + 1);
if old_list_link.get_tag() == HeapCellValueTag::Lis {
self.attr_var_list_locs.push((threshold + 1, old_list_link));
}
}
}
_ => {
@@ -298,8 +354,6 @@ impl<T: CopierTarget> CopyTermState<T> {
}
);
}
self.unwind_trail();
}
fn unwind_trail(&mut self) {
@@ -327,8 +381,9 @@ mod tests {
let a_atom = atom!("a");
let b_atom = atom!("b");
wam.machine_st.heap
.extend(functor!(f_atom, [atom(a_atom), atom(b_atom)]));
wam.machine_st
.heap
.extend(functor!(f_atom, [atom(a_atom), atom(b_atom)]));
assert_eq!(wam.machine_st.heap[0], atom_as_cell!(f_atom, 2));
assert_eq!(wam.machine_st.heap[1], atom_as_cell!(a_atom));
@@ -351,20 +406,26 @@ mod tests {
wam.machine_st.heap.clear();
let pstr_var_cell = put_partial_string(&mut wam.machine_st.heap, "abc ", &mut wam.machine_st.atom_tbl);
let pstr_var_cell =
put_partial_string(&mut wam.machine_st.heap, "abc ", &wam.machine_st.atom_tbl);
let pstr_cell = wam.machine_st.heap[pstr_var_cell.get_value() as usize];
wam.machine_st.heap.pop();
wam.machine_st.heap.push(pstr_loc_as_cell!(2));
let pstr_second_var_cell = put_partial_string(&mut wam.machine_st.heap, "def", &mut wam.machine_st.atom_tbl);
let pstr_second_var_cell =
put_partial_string(&mut wam.machine_st.heap, "def", &wam.machine_st.atom_tbl);
let pstr_second_cell = wam.machine_st.heap[pstr_second_var_cell.get_value() as usize];
wam.machine_st.heap.pop();
wam.machine_st.heap.push(pstr_loc_as_cell!(wam.machine_st.heap.len() + 1));
wam.machine_st
.heap
.push(pstr_loc_as_cell!(wam.machine_st.heap.len() + 1));
wam.machine_st.heap.push(pstr_offset_as_cell!(0));
wam.machine_st.heap.push(fixnum_as_cell!(Fixnum::build_with(0i64)));
wam.machine_st
.heap
.push(fixnum_as_cell!(Fixnum::build_with(0i64)));
{
let wam = TermCopyingMockWAM { wam: &mut wam };
@@ -378,14 +439,20 @@ mod tests {
assert_eq!(wam.machine_st.heap[2], pstr_second_cell);
assert_eq!(wam.machine_st.heap[3], pstr_loc_as_cell!(4));
assert_eq!(wam.machine_st.heap[4], pstr_offset_as_cell!(0));
assert_eq!(wam.machine_st.heap[5], fixnum_as_cell!(Fixnum::build_with(0i64)));
assert_eq!(
wam.machine_st.heap[5],
fixnum_as_cell!(Fixnum::build_with(0i64))
);
assert_eq!(wam.machine_st.heap[7], pstr_cell);
assert_eq!(wam.machine_st.heap[8], pstr_loc_as_cell!(9));
assert_eq!(wam.machine_st.heap[9], pstr_second_cell);
assert_eq!(wam.machine_st.heap[10], pstr_loc_as_cell!(11));
assert_eq!(wam.machine_st.heap[11], pstr_offset_as_cell!(7));
assert_eq!(wam.machine_st.heap[12], fixnum_as_cell!(Fixnum::build_with(0i64)));
assert_eq!(
wam.machine_st.heap[12],
fixnum_as_cell!(Fixnum::build_with(0i64))
);
wam.machine_st.heap.clear();

View File

@@ -0,0 +1,429 @@
use crate::atom_table::*;
use crate::types::*;
/* Use the pointer reversal technique of the Deutsch-Schorr-Waite
* algorithm to detect cycles in Prolog terms.
*
* Much of the structure and nomenclature of the GC marking algorithm
* is adapted here but there are a few significant changes:
*
* - Forwarded cells now form a trail of bread crumbs leading back to self.start
* - Cells are only marked during the backward phase
* - Visiting subterms of a visited compound does not immediately shift to the backward phase
* - The heads of LIS structures are both marked and forwarded rather
* than just forwarded to distinguish them from tails;
* continue_forwarding() checks for this before entering the forward
* phase
*
* Commonalities with the GC marking algorithm:
* - The contents of forwarded cells are modified only when they are unforwarded
* - Marked (but unforwarded!) cells immediately shift to the backward phase
*/
#[derive(Debug)]
pub(crate) struct CycleDetectingIter<'a, const STOP_AT_CYCLES: bool> {
pub(crate) heap: &'a mut [HeapCellValue],
start: usize,
current: usize,
next: u64,
cycle_found: bool,
mark_phase: bool,
}
impl<'a, const STOP_AT_CYCLES: bool> CycleDetectingIter<'a, STOP_AT_CYCLES> {
pub(crate) fn new(heap: &'a mut [HeapCellValue], start: usize) -> Self {
heap[start].set_forwarding_bit(true);
let next = heap[start].get_value();
Self {
heap,
start,
current: start,
next,
cycle_found: false,
mark_phase: true,
}
}
#[inline]
pub(crate) fn cycle_found(&self) -> bool {
self.cycle_found
}
#[inline]
fn cycle_detection_active(&self) -> bool {
STOP_AT_CYCLES && self.mark_phase && !self.cycle_found
}
fn backward_and_return(&mut self) -> HeapCellValue {
let mut current = self.heap[self.current];
current.set_value(self.next);
if self.backward() {
// set the f and m bits on the heap cell at start
// so we invoke backward() and return None next call.
self.heap[self.current].set_forwarding_bit(false);
self.heap[self.current].set_mark_bit(self.mark_phase);
}
current
}
fn traverse_subterm(&mut self, h: usize, arity: usize) -> Option<usize> {
let mut last_cell_loc = h + arity - 1;
for idx in (h .. h + arity).rev() {
if self.heap[idx].get_forwarding_bit() {
if self.cycle_detection_active() {
self.cycle_found = true;
return None;
}
last_cell_loc -= 1;
} else if self.heap[idx].get_mark_bit() == self.mark_phase {
last_cell_loc -= 1;
} else {
break;
}
}
Some(last_cell_loc)
}
#[inline]
fn continue_forwarding(&self) -> bool {
self.heap[self.current].get_mark_bit() != self.mark_phase ||
self.heap[self.current].get_forwarding_bit()
}
fn forward(&mut self) -> Option<HeapCellValue> {
loop {
if self.continue_forwarding() {
match self.heap[self.current].get_tag() {
tag @ HeapCellValueTag::AttrVar | tag @ HeapCellValueTag::Var => {
let next = self.next as usize;
if self.heap[next].get_forwarding_bit() {
return if self.current != next {
if self.cycle_detection_active() {
self.cycle_found = true;
None
} else {
Some(self.backward_and_return())
}
} else {
Some(self.backward_and_return())
};
} else if self.heap[next].get_mark_bit() == self.mark_phase {
return Some(self.backward_and_return());
}
self.heap[next].set_forwarding_bit(true);
let temp = self.heap[next].get_value();
self.heap[next].set_value(self.current as u64);
self.current = next;
self.next = temp;
if self.next < self.heap.len() as u64 {
return Some(HeapCellValue::build_with(tag, next as u64));
}
}
HeapCellValueTag::Str => {
let h = self.next as usize;
let cell = self.heap[h];
let arity = cell_as_atom_cell!(self.heap[h]).get_arity();
let last_cell_loc = match self.traverse_subterm(h + 1, arity) {
Some(last_cell_loc) => last_cell_loc,
None => return None,
};
if last_cell_loc == h {
if self.backward() {
return None;
}
continue;
}
if self.cycle_detection_active() {
for idx in (h + 1 .. last_cell_loc).rev() {
if self.heap[idx].get_forwarding_bit() {
self.cycle_found = true;
return None;
}
}
}
self.heap[last_cell_loc].set_forwarding_bit(true);
self.next = self.heap[last_cell_loc].get_value();
self.heap[last_cell_loc].set_value(self.current as u64);
self.current = last_cell_loc;
return Some(cell);
}
HeapCellValueTag::Lis => {
let mut cell = self.heap[self.current];
cell.set_value(self.next);
let last_cell_loc = match self.traverse_subterm(self.next as usize, 2) {
Some(last_cell_loc) => last_cell_loc,
None => return None,
};
if self.cycle_detection_active() {
for idx in (self.next as usize .. last_cell_loc).rev() {
if self.heap[idx].get_forwarding_bit() {
self.cycle_found = true;
return None;
}
}
}
if (last_cell_loc + 1) as u64 == self.next {
if self.backward() {
return None;
}
continue;
} else if last_cell_loc as u64 == self.next {
// car cells of lists are both marked and forwarded.
self.heap[last_cell_loc].set_mark_bit(self.mark_phase);
}
self.heap[last_cell_loc].set_forwarding_bit(true);
self.next = self.heap[last_cell_loc].get_value();
self.heap[last_cell_loc].set_value(self.current as u64);
self.current = last_cell_loc;
return Some(cell);
}
HeapCellValueTag::PStrLoc => {
let h = self.next as usize;
let cell = self.heap[h];
let last_cell_loc = h + 1;
if self.heap[last_cell_loc].get_forwarding_bit() {
if self.cycle_detection_active() {
self.cycle_found = true;
return None;
} else if self.backward() {
return None;
}
continue;
}
self.heap[last_cell_loc].set_forwarding_bit(true);
self.next = self.heap[last_cell_loc].get_value();
self.heap[last_cell_loc].set_value(self.current as u64);
self.current = last_cell_loc;
return Some(cell);
}
HeapCellValueTag::PStrOffset => {
let h = self.next as usize;
let cell = self.heap[h];
let last_cell_loc = h + 1;
if self.heap[h].get_tag() == HeapCellValueTag::PStr {
if self.heap[last_cell_loc].get_forwarding_bit() {
if self.cycle_detection_active() {
self.cycle_found = true;
return None;
} else if self.backward() {
return None;
}
continue;
}
self.heap[last_cell_loc].set_forwarding_bit(true);
self.next = self.heap[last_cell_loc].get_value();
self.heap[last_cell_loc].set_value(self.current as u64);
self.current = last_cell_loc;
} else {
debug_assert!(self.heap[h].get_tag() == HeapCellValueTag::CStr);
self.next = self.heap[h].get_value();
self.heap[h].set_value(self.current as u64);
self.current = h;
}
return Some(cell);
}
tag @ HeapCellValueTag::Atom => {
let cell = HeapCellValue::build_with(tag, self.next);
let arity = AtomCell::from_bytes(cell.into_bytes()).get_arity();
if arity == 0 {
return Some(self.backward_and_return());
} else if self.backward() {
return None;
}
}
HeapCellValueTag::PStr => {
if self.backward() {
return None;
}
}
_ => {
return Some(self.backward_and_return());
}
}
} else if self.backward() {
return None;
}
}
}
fn pivot_subterm(&mut self) {
self.current -= 1;
let temp = self.heap[self.current + 1].get_value();
self.heap[self.current + 1].set_value(self.next);
self.next = self.heap[self.current].get_value();
self.heap[self.current].set_value(temp);
self.heap[self.current].set_forwarding_bit(true);
}
fn continue_backward(&mut self) -> bool {
self.heap[self.current].set_forwarding_bit(false);
if self.current == self.start {
return false;
}
let temp = self.heap[self.current].get_value();
match self.heap[temp as usize].get_tag() {
HeapCellValueTag::Str => {
let mut new_str_back_link = self.current;
for idx in (0 .. self.current).rev() {
if self.heap[idx].get_tag() == HeapCellValueTag::Atom {
if cell_as_atom_cell!(self.heap[idx]).get_arity() > 0 {
new_str_back_link = idx;
break;
}
}
if self.heap[idx].get_mark_bit() != self.mark_phase {
if !self.heap[idx].get_forwarding_bit() {
new_str_back_link = idx;
break;
}
}
}
self.heap[self.current].set_mark_bit(self.mark_phase);
self.heap[self.current].set_value(self.next);
let back_link_cell = self.heap[new_str_back_link];
self.next = back_link_cell.get_value();
self.heap[new_str_back_link].set_value(temp);
self.current = new_str_back_link;
read_heap_cell!(back_link_cell,
(HeapCellValueTag::Atom, (_name, arity)) => {
if arity > 0 {
self.heap[self.current].set_mark_bit(self.mark_phase);
return true;
}
}
_ => {}
);
self.heap[self.current].set_forwarding_bit(true);
false
}
HeapCellValueTag::Lis => {
if self.heap[self.current].get_mark_bit() == self.mark_phase {
true
} else {
self.heap[self.current - 1].set_mark_bit(self.mark_phase);
self.heap[self.current].set_mark_bit(self.mark_phase);
if self.heap[self.current - 1].get_forwarding_bit() {
self.heap[self.current].set_value(self.next);
self.next = self.current as u64 - 1;
self.current = temp as usize;
true
} else {
self.pivot_subterm();
false
}
}
}
_ => {
self.heap[self.current].set_mark_bit(self.mark_phase);
true
}
}
}
fn backward(&mut self) -> bool {
while self.continue_backward() {
let temp = self.heap[self.current].get_value();
self.heap[self.current].set_value(self.next);
self.next = self.current as u64;
self.current = temp as usize;
}
if self.current == self.start {
return true;
}
false
}
fn invert_marker(&mut self) {
self.cycle_found = false;
if self.heap[self.start].get_forwarding_bit() {
while !self.backward() {}
}
self.mark_phase = false;
self.heap[self.start].set_forwarding_bit(true);
self.next = self.heap[self.start].get_value();
self.current = self.start;
while let Some(_) = self.forward() {}
}
}
impl<'a, const STOP_AT_CYCLES: bool> Iterator for CycleDetectingIter<'a, STOP_AT_CYCLES> {
type Item = HeapCellValue;
#[inline]
fn next(&mut self) -> Option<Self::Item> {
self.forward()
}
}
impl<'a, const STOP_AT_CYCLES: bool> Drop for CycleDetectingIter<'a, STOP_AT_CYCLES> {
fn drop(&mut self) {
self.invert_marker();
if self.current == self.start {
return;
}
while !self.backward() {}
}
}

914
src/machine/disjuncts.rs Normal file
View File

@@ -0,0 +1,914 @@
use crate::atom_table::*;
use crate::forms::*;
use crate::instructions::*;
use crate::iterators::*;
use crate::machine::loader::*;
use crate::machine::machine_errors::CompilationError;
use crate::machine::preprocessor::*;
use crate::parser::ast::*;
use crate::parser::dashu::Rational;
use crate::variable_records::*;
use dashu::Integer;
use indexmap::{IndexMap, IndexSet};
use std::cell::Cell;
use std::cmp::Ordering;
use std::collections::VecDeque;
use std::hash::{Hash, Hasher};
use std::ops::{Deref, DerefMut};
#[derive(Debug, Clone)] //, PartialOrd, PartialEq, Eq, Hash)]
pub struct BranchNumber {
branch_num: Rational,
delta: Rational,
}
impl Default for BranchNumber {
fn default() -> Self {
Self {
branch_num: Rational::from(1u64 << 63),
delta: Rational::from(1),
}
}
}
impl PartialEq<BranchNumber> for BranchNumber {
#[inline]
fn eq(&self, rhs: &BranchNumber) -> bool {
self.branch_num == rhs.branch_num
}
}
impl Eq for BranchNumber {}
impl Hash for BranchNumber {
#[inline(always)]
fn hash<H: Hasher>(&self, hasher: &mut H) {
self.branch_num.hash(hasher)
}
}
impl PartialOrd<BranchNumber> for BranchNumber {
#[inline]
fn partial_cmp(&self, rhs: &BranchNumber) -> Option<Ordering> {
self.branch_num.partial_cmp(&rhs.branch_num)
}
}
impl BranchNumber {
fn split(&self) -> BranchNumber {
BranchNumber {
branch_num: self.branch_num.clone() + &self.delta / Rational::from(2),
delta: &self.delta / Rational::from(4),
}
}
fn incr_by_delta(&self) -> BranchNumber {
BranchNumber {
branch_num: self.branch_num.clone() + &self.delta,
delta: self.delta.clone(),
}
}
fn halve_delta(&self) -> BranchNumber {
BranchNumber {
branch_num: self.branch_num.clone(),
delta: &self.delta / Rational::from(2),
}
}
}
#[derive(Debug, Clone, PartialEq, Eq, Hash)]
pub struct VarInfo {
var_ptr: VarPtr,
chunk_type: ChunkType,
classify_info: ClassifyInfo,
lvl: Level,
}
#[derive(Debug, Clone, PartialEq, Eq, Hash)]
pub struct ChunkInfo {
chunk_num: usize,
term_loc: GenContext,
// pointer to incidence, term occurrence arity.
vars: Vec<VarInfo>,
}
#[derive(Debug)]
pub struct BranchArm {
pub arm_terms: Vec<QueryTerm>,
}
#[derive(Debug, Clone, PartialEq, Eq, Hash)]
pub struct BranchInfo {
branch_num: BranchNumber,
chunks: Vec<ChunkInfo>,
}
impl BranchInfo {
fn new(branch_num: BranchNumber) -> Self {
Self {
branch_num,
chunks: vec![],
}
}
}
type BranchMapInt = IndexMap<VarPtr, Vec<BranchInfo>>;
#[derive(Debug, Clone)]
pub struct BranchMap(BranchMapInt);
impl Deref for BranchMap {
type Target = BranchMapInt;
#[inline(always)]
fn deref(&self) -> &BranchMapInt {
&self.0
}
}
impl DerefMut for BranchMap {
#[inline(always)]
fn deref_mut(&mut self) -> &mut BranchMapInt {
&mut self.0
}
}
type RootSet = IndexSet<BranchNumber>;
#[derive(Debug, Clone, Copy, PartialEq, Eq, Hash)]
pub struct ClassifyInfo {
arg_c: usize,
arity: usize,
}
enum TraversalState {
// construct a QueryTerm::Branch with number of disjuncts, reset
// the chunk type to that of the chunk preceding the disjunct and the chunk_num.
BuildDisjunct(usize),
// add the last disjunct to a QueryTerm::Branch, continuing from
// where it leaves off.
BuildFinalDisjunct(usize),
Fail,
GetCutPoint { var_num: usize, prev_b: bool },
Cut { var_num: usize, is_global: bool },
CutPrev(usize),
ResetCallPolicy(CallPolicy),
Term(Term),
OverrideGlobalCutVar(usize),
ResetGlobalCutVarOverride(Option<usize>),
RemoveBranchNum, // pop the current_branch_num and from the root set.
AddBranchNum(BranchNumber), // set current_branch_num, add it to the root set
RepBranchNum(BranchNumber), // replace current_branch_num and the latest in the root set
}
#[derive(Debug)]
pub struct VariableClassifier {
call_policy: CallPolicy,
current_branch_num: BranchNumber,
current_chunk_num: usize,
current_chunk_type: ChunkType,
branch_map: BranchMap,
var_num: usize,
root_set: RootSet,
global_cut_var_num: Option<usize>,
global_cut_var_num_override: Option<usize>,
}
#[derive(Debug, Default)]
pub struct VarData {
pub records: VariableRecords,
pub global_cut_var_num: Option<usize>,
pub allocates: bool,
}
impl VarData {
fn emit_initial_get_level(&mut self, build_stack: &mut ChunkedTermVec) {
let global_cut_var_num = if let &Some(global_cut_var_num) = &self.global_cut_var_num {
match &self.records[global_cut_var_num].allocation {
VarAlloc::Perm(..) => Some(global_cut_var_num),
VarAlloc::Temp { term_loc, .. } if term_loc.chunk_num() > 0 => {
Some(global_cut_var_num)
}
_ => None,
}
} else {
None
};
if let Some(global_cut_var_num) = global_cut_var_num {
let term = QueryTerm::GetLevel(global_cut_var_num);
self.records[global_cut_var_num].allocation =
VarAlloc::Perm(0, PermVarAllocation::Pending);
match build_stack.front_mut() {
Some(ChunkedTerms::Branch(_)) => {
build_stack.push_front(ChunkedTerms::Chunk(VecDeque::from(vec![term])));
}
Some(ChunkedTerms::Chunk(chunk)) => {
chunk.push_front(term);
}
None => {
unreachable!()
}
}
}
}
}
pub type ClassifyFactResult = (Term, VarData);
pub type ClassifyRuleResult = (Term, ChunkedTermVec, VarData);
fn merge_branch_seq(branches: impl Iterator<Item = BranchInfo>) -> BranchInfo {
let mut branch_info = BranchInfo::new(BranchNumber::default());
for mut branch in branches {
branch_info.branch_num = branch.branch_num;
branch_info.chunks.extend(branch.chunks.drain(..));
}
branch_info.branch_num.delta = branch_info.branch_num.delta * Integer::from(2);
branch_info.branch_num.branch_num -= &branch_info.branch_num.delta;
branch_info
}
fn flatten_into_disjunct(build_stack: &mut ChunkedTermVec, preceding_len: usize) {
let branch_vec = build_stack.drain(preceding_len + 1..).collect();
if let ChunkedTerms::Branch(ref mut disjuncts) = &mut build_stack[preceding_len] {
disjuncts.push(branch_vec);
} else {
unreachable!();
}
}
impl VariableClassifier {
pub fn new(call_policy: CallPolicy) -> Self {
Self {
call_policy,
current_branch_num: BranchNumber::default(),
current_chunk_num: 0,
current_chunk_type: ChunkType::Head,
branch_map: BranchMap(BranchMapInt::new()),
root_set: RootSet::new(),
var_num: 0,
global_cut_var_num: None,
global_cut_var_num_override: None,
}
}
pub fn classify_fact(mut self, term: Term) -> Result<ClassifyFactResult, CompilationError> {
self.classify_head_variables(&term)?;
Ok((
term,
self.branch_map.separate_and_classify_variables(
self.var_num,
self.global_cut_var_num,
self.current_chunk_num,
),
))
}
pub fn classify_rule<'a, LS: LoadState<'a>>(
mut self,
loader: &mut Loader<'a, LS>,
head: Term,
body: Term,
) -> Result<ClassifyRuleResult, CompilationError> {
self.classify_head_variables(&head)?;
self.root_set.insert(self.current_branch_num.clone());
let mut query_terms = self.classify_body_variables(loader, body)?;
self.merge_branches();
let mut var_data = self.branch_map.separate_and_classify_variables(
self.var_num,
self.global_cut_var_num,
self.current_chunk_num,
);
var_data.emit_initial_get_level(&mut query_terms);
Ok((head, query_terms, var_data))
}
fn merge_branches(&mut self) {
for branches in self.branch_map.values_mut() {
let mut old_branches = std::mem::replace(branches, vec![]);
while let Some(last_branch_num) = old_branches.last().map(|bi| &bi.branch_num) {
let mut old_branches_len = old_branches.len();
for (rev_idx, bi) in old_branches.iter().rev().enumerate() {
if &bi.branch_num > last_branch_num {
old_branches_len = old_branches.len() - rev_idx;
}
}
let iter = old_branches.drain(old_branches_len - 1..);
branches.push(merge_branch_seq(iter));
}
branches.reverse();
}
}
fn try_set_chunk_at_inlined_boundary(&mut self) -> bool {
if self.current_chunk_type.is_last() {
self.current_chunk_type = ChunkType::Mid;
self.current_chunk_num += 1;
true
} else {
false
}
}
fn try_set_chunk_at_call_boundary(&mut self) -> bool {
if self.current_chunk_type.is_last() {
self.current_chunk_num += 1;
true
} else {
self.current_chunk_type = ChunkType::Last;
false
}
}
fn probe_body_term(&mut self, arg_c: usize, arity: usize, term: &Term) {
let classify_info = ClassifyInfo { arg_c, arity };
// second arg is true to iterate the root, which may be a variable
for term_ref in breadth_first_iter(term, RootIterationPolicy::Iterated) {
if let TermRef::Var(lvl, _, var_ptr) = term_ref {
// root terms are shallow here (since we're iterating a
// body term) so take the child level.
let lvl = lvl.child_level();
self.probe_body_var(VarInfo {
var_ptr,
lvl,
classify_info,
chunk_type: self.current_chunk_type,
});
}
}
}
fn probe_body_var(&mut self, var_info: VarInfo) {
let term_loc = self
.current_chunk_type
.to_gen_context(self.current_chunk_num);
let branch_info_v = self
.branch_map
.entry(var_info.var_ptr.clone())
.or_insert_with(|| vec![]);
let needs_new_branch = if let Some(last_bi) = branch_info_v.last() {
!self.root_set.contains(&last_bi.branch_num)
} else {
true
};
if needs_new_branch {
branch_info_v.push(BranchInfo::new(self.current_branch_num.clone()));
}
let branch_info = branch_info_v.last_mut().unwrap();
let needs_new_chunk = if let Some(last_ci) = branch_info.chunks.last() {
last_ci.chunk_num != self.current_chunk_num
} else {
true
};
if needs_new_chunk {
branch_info.chunks.push(ChunkInfo {
chunk_num: self.current_chunk_num,
term_loc,
vars: vec![],
});
}
let chunk_info = branch_info.chunks.last_mut().unwrap();
chunk_info.vars.push(var_info);
}
fn probe_in_situ_var(&mut self, var_num: usize) {
let classify_info = ClassifyInfo { arg_c: 1, arity: 1 };
let var_info = VarInfo {
var_ptr: VarPtr::from(Var::InSitu(var_num)),
classify_info,
chunk_type: self.current_chunk_type,
lvl: Level::Shallow,
};
self.probe_body_var(var_info);
}
fn classify_head_variables(&mut self, term: &Term) -> Result<(), CompilationError> {
match term {
Term::Clause(..) | Term::Literal(_, Literal::Atom(_)) => {}
_ => return Err(CompilationError::InvalidRuleHead),
}
let mut classify_info = ClassifyInfo {
arg_c: 1,
arity: term.arity(),
};
match term {
Term::Clause(_, _, terms) => {
for term in terms.into_iter() {
for term_ref in breadth_first_iter(term, RootIterationPolicy::Iterated) {
if let TermRef::Var(lvl, _, var_ptr) = term_ref {
// a body term, so we need the child level here.
let lvl = lvl.child_level();
// the body of the if let here is an inlined
// "probe_head_var". note the difference between it
// and "probe_body_var".
let branch_info_v = self
.branch_map
.entry(var_ptr.clone())
.or_insert_with(|| vec![]);
let needs_new_branch = branch_info_v.is_empty();
if needs_new_branch {
branch_info_v
.push(BranchInfo::new(self.current_branch_num.clone()));
}
let branch_info = branch_info_v.last_mut().unwrap();
let needs_new_chunk = branch_info.chunks.is_empty();
if needs_new_chunk {
branch_info.chunks.push(ChunkInfo {
chunk_num: self.current_chunk_num,
term_loc: GenContext::Head,
vars: vec![],
});
}
let chunk_info = branch_info.chunks.last_mut().unwrap();
let var_info = VarInfo {
var_ptr,
classify_info,
chunk_type: self.current_chunk_type,
lvl,
};
chunk_info.vars.push(var_info);
}
}
classify_info.arg_c += 1;
}
}
_ => {}
}
Ok(())
}
fn classify_body_variables<'a, LS: LoadState<'a>>(
&mut self,
loader: &mut Loader<'a, LS>,
term: Term,
) -> Result<ChunkedTermVec, CompilationError> {
let mut state_stack = vec![TraversalState::Term(term)];
let mut build_stack = ChunkedTermVec::new();
self.current_chunk_type = ChunkType::Mid;
while let Some(traversal_st) = state_stack.pop() {
match traversal_st {
TraversalState::AddBranchNum(branch_num) => {
self.root_set.insert(branch_num.clone());
self.current_branch_num = branch_num;
}
TraversalState::RemoveBranchNum => {
self.root_set.pop();
}
TraversalState::RepBranchNum(branch_num) => {
self.root_set.pop();
self.root_set.insert(branch_num.clone());
self.current_branch_num = branch_num;
}
TraversalState::ResetCallPolicy(call_policy) => {
self.call_policy = call_policy;
}
TraversalState::BuildDisjunct(preceding_len) => {
flatten_into_disjunct(&mut build_stack, preceding_len);
self.current_chunk_type = ChunkType::Mid;
self.current_chunk_num += 1;
}
TraversalState::BuildFinalDisjunct(preceding_len) => {
flatten_into_disjunct(&mut build_stack, preceding_len);
self.current_chunk_type = ChunkType::Mid;
self.current_chunk_num += 1;
}
TraversalState::GetCutPoint { var_num, prev_b } => {
if self.try_set_chunk_at_inlined_boundary() {
build_stack.add_chunk();
}
self.probe_in_situ_var(var_num);
build_stack.push_chunk_term(QueryTerm::GetCutPoint { var_num, prev_b });
}
TraversalState::OverrideGlobalCutVar(var_num) => {
self.global_cut_var_num_override = Some(var_num);
}
TraversalState::ResetGlobalCutVarOverride(old_override) => {
self.global_cut_var_num_override = old_override;
}
TraversalState::Cut { var_num, is_global } => {
if self.try_set_chunk_at_inlined_boundary() {
build_stack.add_chunk();
}
self.probe_in_situ_var(var_num);
build_stack.push_chunk_term(if is_global {
QueryTerm::GlobalCut(var_num)
} else {
QueryTerm::LocalCut { var_num, cut_prev: false }
});
}
TraversalState::CutPrev(var_num) => {
if self.try_set_chunk_at_inlined_boundary() {
build_stack.add_chunk();
}
self.probe_in_situ_var(var_num);
build_stack.push_chunk_term(QueryTerm::LocalCut { var_num, cut_prev: true });
}
TraversalState::Fail => {
build_stack.push_chunk_term(QueryTerm::Fail);
}
TraversalState::Term(term) => {
// return true iff new chunk should be added.
let update_chunk_data = |classifier: &mut Self, predicate_name, arity| {
if ClauseType::is_inlined(predicate_name, arity) {
classifier.try_set_chunk_at_inlined_boundary()
} else {
classifier.try_set_chunk_at_call_boundary()
}
};
let mut add_chunk = |classifier: &mut Self, name: Atom, terms: Vec<Term>| {
if update_chunk_data(classifier, name, terms.len()) {
build_stack.add_chunk();
}
for (arg_c, term) in terms.iter().enumerate() {
classifier.probe_body_term(arg_c + 1, terms.len(), term);
}
build_stack.push_chunk_term(clause_to_query_term(
loader,
name,
terms,
classifier.call_policy,
));
};
match term {
Term::Clause(
_,
name @ (atom!("->") | atom!(";") | atom!(",")),
mut terms,
) if terms.len() == 3 => {
if let Some(last_arg) = terms.last() {
if let Term::Literal(_, Literal::CodeIndex(_)) = last_arg {
terms.pop();
state_stack.push(TraversalState::Term(Term::Clause(
Cell::default(),
name,
terms,
)));
} else {
add_chunk(self, name, terms);
}
}
}
Term::Clause(_, atom!(","), mut terms) if terms.len() == 2 => {
let tail = terms.pop().unwrap();
let head = terms.pop().unwrap();
let iter = unfold_by_str(tail, atom!(","))
.into_iter()
.rev()
.chain(std::iter::once(head))
.map(TraversalState::Term);
state_stack.extend(iter);
}
Term::Clause(_, atom!(";"), mut terms) if terms.len() == 2 => {
let tail = terms.pop().unwrap();
let head = terms.pop().unwrap();
let first_branch_num = self.current_branch_num.split();
let branches: Vec<_> = std::iter::once(head)
.chain(unfold_by_str(tail, atom!(";")).into_iter())
.collect();
let mut branch_numbers = vec![first_branch_num];
for idx in 1..branches.len() {
let succ_branch_number = branch_numbers[idx - 1].incr_by_delta();
branch_numbers.push(if idx + 1 < branches.len() {
succ_branch_number.split()
} else {
succ_branch_number
});
}
let build_stack_len = build_stack.len();
build_stack.reserve_branch(branches.len());
state_stack.push(TraversalState::RepBranchNum(
self.current_branch_num.halve_delta(),
));
let iter = branches.into_iter().zip(branch_numbers.into_iter());
let final_disjunct_loc = state_stack.len();
for (term, branch_num) in iter.rev() {
state_stack.push(TraversalState::BuildDisjunct(build_stack_len));
state_stack.push(TraversalState::RemoveBranchNum);
state_stack.push(TraversalState::Term(term));
state_stack.push(TraversalState::AddBranchNum(branch_num));
}
if let TraversalState::BuildDisjunct(build_stack_len) =
state_stack[final_disjunct_loc]
{
state_stack[final_disjunct_loc] =
TraversalState::BuildFinalDisjunct(build_stack_len);
}
self.current_chunk_type = ChunkType::Mid;
self.current_chunk_num += 1;
}
Term::Clause(_, atom!("->"), mut terms) if terms.len() == 2 => {
let then_term = terms.pop().unwrap();
let if_term = terms.pop().unwrap();
let prev_b = if matches!(
state_stack.last(),
Some(TraversalState::RemoveBranchNum)
) {
// check if the second-to-last element is a regular BuildDisjunct, as we don't
// want to add GetPrevLevel in case of a TrustMe.
matches!(
state_stack.iter().rev().nth(1),
Some(TraversalState::BuildDisjunct(..))
)
} else {
false
};
state_stack.push(TraversalState::Term(then_term));
state_stack.push(TraversalState::Cut {
var_num: self.var_num,
is_global: false,
});
state_stack.push(TraversalState::Term(if_term));
state_stack.push(TraversalState::GetCutPoint {
var_num: self.var_num,
prev_b,
});
self.var_num += 1;
}
Term::Clause(_, atom!("\\+"), mut terms) if terms.len() == 1 => {
let not_term = terms.pop().unwrap();
let build_stack_len = build_stack.len();
build_stack.reserve_branch(2);
state_stack.push(TraversalState::BuildFinalDisjunct(build_stack_len));
state_stack.push(TraversalState::Term(Term::Clause(
Cell::default(),
atom!("$succeed"),
vec![],
)));
state_stack.push(TraversalState::BuildDisjunct(build_stack_len));
state_stack.push(TraversalState::Fail);
state_stack.push(TraversalState::CutPrev(self.var_num));
state_stack.push(TraversalState::ResetGlobalCutVarOverride(self.global_cut_var_num_override));
state_stack.push(TraversalState::Term(not_term));
state_stack.push(TraversalState::OverrideGlobalCutVar(self.var_num));
state_stack.push(TraversalState::GetCutPoint {
var_num: self.var_num,
prev_b: false,
});
self.current_chunk_type = ChunkType::Mid;
self.current_chunk_num += 1;
self.var_num += 1;
}
Term::Clause(_, atom!(":"), mut terms) if terms.len() == 2 => {
let predicate_name = terms.pop().unwrap();
let module_name = terms.pop().unwrap();
match (module_name, predicate_name) {
(
Term::Literal(_, Literal::Atom(module_name)),
Term::Literal(_, Literal::Atom(predicate_name)),
) => {
if update_chunk_data(self, predicate_name, 0) {
build_stack.add_chunk();
}
build_stack.push_chunk_term(qualified_clause_to_query_term(
loader,
module_name,
predicate_name,
vec![],
self.call_policy,
));
}
(
Term::Literal(_, Literal::Atom(module_name)),
Term::Clause(_, name, terms),
) => {
if update_chunk_data(self, name, terms.len()) {
build_stack.add_chunk();
}
for (arg_c, term) in terms.iter().enumerate() {
self.probe_body_term(arg_c + 1, terms.len(), term);
}
build_stack.push_chunk_term(qualified_clause_to_query_term(
loader,
module_name,
name,
terms,
self.call_policy,
));
}
(module_name, predicate_name) => {
if update_chunk_data(self, atom!("call"), 2) {
build_stack.add_chunk();
}
self.probe_body_term(1, 0, &module_name);
self.probe_body_term(2, 0, &predicate_name);
terms.push(module_name);
terms.push(predicate_name);
build_stack.push_chunk_term(clause_to_query_term(
loader,
atom!("call"),
vec![Term::Clause(Cell::default(), atom!(":"), terms)],
self.call_policy,
));
}
}
}
Term::Clause(_, atom!("$call_with_inference_counting"), mut terms)
if terms.len() == 1 =>
{
state_stack.push(TraversalState::ResetCallPolicy(self.call_policy));
state_stack.push(TraversalState::Term(terms.pop().unwrap()));
self.call_policy = CallPolicy::Counted;
}
Term::Clause(_, name, terms) => {
add_chunk(self, name, terms);
}
var @ Term::Var(..) => {
if update_chunk_data(self, atom!("call"), 1) {
build_stack.add_chunk();
}
self.probe_body_term(1, 1, &var);
build_stack.push_chunk_term(clause_to_query_term(
loader,
atom!("call"),
vec![var],
self.call_policy,
));
}
Term::Literal(_, Literal::Atom(atom!("!")) | Literal::Char('!')) => {
let (var_num, is_global) =
if let Some(var_num) = self.global_cut_var_num_override {
(var_num, false)
} else if let Some(var_num) = self.global_cut_var_num {
(var_num, true)
} else {
let var_num = self.var_num;
self.global_cut_var_num = Some(var_num);
self.var_num += 1;
(var_num, true)
};
self.probe_in_situ_var(var_num);
state_stack.push(TraversalState::Cut { var_num, is_global });
}
Term::Literal(_, Literal::Atom(name)) => {
if update_chunk_data(self, name, 0) {
build_stack.add_chunk();
}
build_stack.push_chunk_term(clause_to_query_term(
loader,
name,
vec![],
self.call_policy,
));
}
_ => {
return Err(CompilationError::InadmissibleQueryTerm);
}
}
}
}
}
Ok(build_stack)
}
}
impl BranchMap {
pub fn separate_and_classify_variables(
&mut self,
var_num: usize,
global_cut_var_num: Option<usize>,
current_chunk_num: usize,
) -> VarData {
let mut var_data = VarData {
records: VariableRecords::new(var_num),
global_cut_var_num,
allocates: current_chunk_num > 0,
};
for (var, branches) in self.iter_mut() {
let (mut var_num, var_num_incr) = if let Var::InSitu(var_num) = *var.borrow() {
(var_num, false)
} else {
(var_data.records.len(), true)
};
for branch in branches.iter_mut() {
if var_num_incr {
var_num = var_data.records.len();
var_data.records.push(VariableRecord::default());
}
if branch.chunks.len() <= 1 {
// true iff var is a temporary variable.
debug_assert_eq!(branch.chunks.len(), 1);
let chunk = &mut branch.chunks[0];
let mut temp_var_data = TempVarData::new();
for var_info in chunk.vars.iter_mut() {
if var_info.lvl == Level::Shallow {
let term_loc = var_info.chunk_type.to_gen_context(chunk.chunk_num);
temp_var_data
.use_set
.insert((term_loc, var_info.classify_info.arg_c));
}
}
var_data.records[var_num].allocation = VarAlloc::Temp {
term_loc: chunk.term_loc,
temp_reg: 0,
temp_var_data,
safety: VarSafetyStatus::Needed,
to_perm_var_num: None,
};
} // else VarAlloc is already a Perm variant, as it's the default.
for chunk in branch.chunks.iter_mut() {
var_data.records[var_num].num_occurrences += chunk.vars.len();
for var_info in chunk.vars.iter_mut() {
var_info.var_ptr.set(Var::Generated(var_num));
}
}
}
}
var_data.records.populate_restricting_sets();
var_data
}
}

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@@ -6,7 +6,7 @@ use crate::machine::partial_string::*;
use crate::parser::ast::*;
use crate::types::*;
use crate::parser::rug::{Integer, Rational};
use crate::parser::dashu::{Integer, Rational};
use std::convert::TryFrom;
@@ -130,11 +130,7 @@ pub fn print_heap_terms<'a, I: Iterator<Item = &'a HeapCellValue>>(heap: I, h: u
}
#[inline]
pub(crate) fn put_complete_string(
heap: &mut Heap,
s: &str,
atom_tbl: &mut AtomTable,
) -> HeapCellValue {
pub(crate) fn put_complete_string(heap: &mut Heap, s: &str, atom_tbl: &AtomTable) -> HeapCellValue {
match allocate_pstr(heap, s, atom_tbl) {
Some(h) => {
heap.pop(); // pop the trailing variable cell from the heap planted by allocate_pstr.
@@ -157,11 +153,7 @@ pub(crate) fn put_complete_string(
}
#[inline]
pub(crate) fn put_partial_string(
heap: &mut Heap,
s: &str,
atom_tbl: &mut AtomTable,
) -> HeapCellValue {
pub(crate) fn put_partial_string(heap: &mut Heap, s: &str, atom_tbl: &AtomTable) -> HeapCellValue {
match allocate_pstr(heap, s, atom_tbl) {
Some(h) => {
pstr_loc_as_cell!(h)
@@ -173,11 +165,7 @@ pub(crate) fn put_partial_string(
}
#[inline]
pub(crate) fn allocate_pstr(
heap: &mut Heap,
mut src: &str,
atom_tbl: &mut AtomTable,
) -> Option<usize> {
pub(crate) fn allocate_pstr(heap: &mut Heap, mut src: &str, atom_tbl: &AtomTable) -> Option<usize> {
let orig_h = heap.len();
loop {
@@ -258,7 +246,10 @@ pub(crate) fn to_local_code_ptr(heap: &Heap, addr: HeapCellValue) -> Option<usiz
let extract_integer = |s: usize| -> Option<usize> {
match Number::try_from(heap[s]) {
Ok(Number::Fixnum(n)) => usize::try_from(n.get_num()).ok(),
Ok(Number::Integer(n)) => n.to_usize(),
Ok(Number::Integer(n)) => {
let value: usize = (&*n).try_into().unwrap();
Some(value)
},
_ => None,
}
};

File diff suppressed because it is too large Load Diff

484
src/machine/lib_machine.rs Normal file
View File

@@ -0,0 +1,484 @@
use std::collections::BTreeMap;
use std::sync::Arc;
use crate::atom_table;
use crate::heap_print::{HCPrinter, HCValueOutputter, PrinterOutputter};
use crate::machine::{BREAK_FROM_DISPATCH_LOOP_LOC, LIB_QUERY_SUCCESS};
use crate::machine::mock_wam::CompositeOpDir;
use crate::parser::parser::{Parser, Tokens};
use crate::read::write_term_to_heap;
use crate::machine::machine_indices::VarKey;
use crate::parser::ast::{Var, VarPtr};
use indexmap::IndexMap;
use super::{
Machine, MachineConfig, QueryResult, QueryResolutionLine,
Atom, AtomCell, HeapCellValue, HeapCellValueTag, Value, QueryResolution,
streams::Stream
};
impl Machine {
pub fn new_lib() -> Self {
Machine::new(MachineConfig::in_memory())
}
pub fn load_module_string(&mut self, module_name: &str, program: String) {
let stream = Stream::from_owned_string(program, &mut self.machine_st.arena);
self.load_file(module_name, stream);
}
pub fn consult_module_string(&mut self, module_name: &str, program: String) {
let stream = Stream::from_owned_string(program, &mut self.machine_st.arena);
self.machine_st.registers[1] = stream_as_cell!(stream);
self.machine_st.registers[2] = atom_as_cell!(&atom_table::AtomTable::build_with(&self.machine_st.atom_tbl, module_name));
self.run_module_predicate(atom!("loader"), (atom!("consult_stream"), 2));
}
fn allocate_stub_choice_point(&mut self) {
// NOTE: create a choice point to terminate the dispatch_loop
// if an exception is thrown. since the and/or stack is presumed empty,
let stub_b = self.machine_st.stack.allocate_or_frame(0);
let or_frame = self.machine_st.stack.index_or_frame_mut(0);
or_frame.prelude.num_cells = 0;
or_frame.prelude.e = 0;
or_frame.prelude.cp = 0;
or_frame.prelude.b = 0;
or_frame.prelude.bp = BREAK_FROM_DISPATCH_LOOP_LOC;
or_frame.prelude.boip = 0;
or_frame.prelude.biip = 0;
or_frame.prelude.tr = 0;
or_frame.prelude.h = 0;
or_frame.prelude.b0 = 0;
or_frame.prelude.attr_var_queue_len = 0;
self.machine_st.b = stub_b;
}
pub fn run_query(&mut self, query: String) -> QueryResult {
println!("Query: {}", query);
// Parse the query so we can analyze and then call the term
let mut parser = Parser::new(
Stream::from_owned_string(query, &mut self.machine_st.arena),
&mut self.machine_st
);
let op_dir = CompositeOpDir::new(&self.indices.op_dir, None);
let term = parser.read_term(&op_dir, Tokens::Default).expect("Failed to parse query");
// Write parsed term to heap
let term_write_result = write_term_to_heap(&term, &mut self.machine_st.heap, &mut self.machine_st.atom_tbl).expect("couldn't write term to heap");
// Write term to heap
self.machine_st.registers[1] = self.machine_st.heap[term_write_result.heap_loc];
self.machine_st.cp = LIB_QUERY_SUCCESS; // BREAK_FROM_DISPATCH_LOOP_LOC;
self.machine_st.p = self.indices.code_dir.get(&(atom!("call"), 1)).expect("couldn't get code index").local().unwrap();
let var_names: IndexMap<_, _> = term_write_result.var_dict.iter()
.map(|(var_key, cell)| match var_key {
// NOTE: not the intention behind Var::InSitu here but
// we can hijack it to store anonymous variables
// without creating problems.
VarKey::AnonVar(h) => (*cell, VarPtr::from(Var::InSitu(*h))),
VarKey::VarPtr(var_ptr) => (*cell, var_ptr.clone()),
})
.collect();
self.allocate_stub_choice_point();
let stub_b = self.machine_st.b;
let mut matches: Vec<QueryResolutionLine> = Vec::new();
// Call the term
loop {
self.dispatch_loop();
//println!("b: {}", self.machine_st.b);
//println!("stub_b: {}", stub_b);
//println!("fail: {}", self.machine_st.fail);
if self.machine_st.ball.stub.len() != 0 {
// NOTE: this means an exception was thrown, at which
// point we backtracked to the stub choice point.
// this should halt the search for solutions as it
// does in the Scryer top-level. the exception term is
// contained in self.machine_st.ball.
let error_string = self.machine_st.ball.stub
.iter()
.filter(|h| match h.get_tag() {
HeapCellValueTag::Atom => true,
HeapCellValueTag::Fixnum => true,
_ => false,
})
.map(|h| match h.get_tag() {
HeapCellValueTag::Atom => {
let (name, _) = cell_as_atom_cell!(h).get_name_and_arity();
name.as_str().to_string()
}
HeapCellValueTag::Fixnum => {
h.get_value().clone().to_string()
},
_ => unreachable!(),
})
.collect::<Vec<String>>()
.join(" ");
return Err(error_string);
}
/*
if self.machine_st.fail {
// NOTE: only print results on success
self.machine_st.fail = false;
println!("fail!");
matches.push(QueryResolutionLine::False);
break;
};
*/
if term_write_result.var_dict.is_empty() {
if self.machine_st.p == LIB_QUERY_SUCCESS {
matches.push(QueryResolutionLine::True);
break;
} else if self.machine_st.p == BREAK_FROM_DISPATCH_LOOP_LOC {
// NOTE: only print results on success
// self.machine_st.fail = false;
// println!("b == stub_b");
matches.push(QueryResolutionLine::False);
break;
}
}
let mut bindings: BTreeMap<String, Value> = BTreeMap::new();
for (var_key, term_to_be_printed) in &term_write_result.var_dict {
if var_key.to_string().starts_with("_") {
continue;
}
let mut printer = HCPrinter::new(
&mut self.machine_st.heap,
Arc::clone(&self.machine_st.atom_tbl),
&mut self.machine_st.stack,
&self.indices.op_dir,
PrinterOutputter::new(),
*term_to_be_printed,
);
printer.ignore_ops = false;
printer.numbervars = true;
printer.quoted = true;
printer.max_depth = 1000; // NOTE: set this to 0 for unbounded depth
printer.double_quotes = true;
printer.var_names = var_names.clone();
let outputter = printer.print();
let output: String = outputter.result();
println!("Result: {} = {}", var_key.to_string(), output);
bindings.insert(var_key.to_string(), Value::try_from(output).expect("asdfs"));
}
matches.push(QueryResolutionLine::Match(bindings));
// NOTE: there are outstanding choicepoints, backtrack
// through them for further solutions. if
// self.machine_st.b == stub_b we've backtracked to the stub
// choice point, so we should break.
self.machine_st.backtrack();
if self.machine_st.b <= stub_b {
// NOTE: out of choicepoints to backtrack through, no
// more solutions to gather.
break;
}
}
// NOTE: deallocate stub choice point
if self.machine_st.b == stub_b {
self.trust_me();
}
Ok(QueryResolution::from(matches))
}
}
#[cfg(test)]
mod tests {
use ordered_float::OrderedFloat;
use super::*;
use crate::machine::{QueryMatch, Value, QueryResolution};
#[test]
fn programatic_query() {
let mut machine = Machine::new_lib();
machine.load_module_string(
"facts",
String::from(
r#"
triple("a", "p1", "b").
triple("a", "p2", "b").
"#,
),
);
let query = String::from(r#"triple("a",P,"b")."#);
let output = machine.run_query(query);
assert_eq!(
output,
Ok(QueryResolution::Matches(vec![
QueryMatch::from(btreemap! {
"P" => Value::from("p1"),
}),
QueryMatch::from(btreemap! {
"P" => Value::from("p2"),
}),
]))
);
assert_eq!(
machine.run_query(String::from(r#"triple("a","p1","b")."#)),
Ok(QueryResolution::True)
);
assert_eq!(
machine.run_query(String::from(r#"triple("x","y","z")."#)),
Ok(QueryResolution::False)
);
}
#[test]
fn failing_query() {
let mut machine = Machine::new_lib();
let query = String::from(r#"triple("a",P,"b")."#);
let output = machine.run_query(query);
assert_eq!(
output,
Err(String::from("error existence_error procedure / triple 3 / triple 3"))
);
}
#[test]
fn complex_results() {
let mut machine = Machine::new_lib();
machine.load_module_string(
"facts",
r#"
:- discontiguous(subject_class/2).
:- discontiguous(constructor/2).
subject_class("Todo", c).
constructor(c, '[{action: "addLink", source: "this", predicate: "todo://state", target: "todo://ready"}]').
subject_class("Recipe", xyz).
constructor(xyz, '[{action: "addLink", source: "this", predicate: "recipe://title", target: "literal://string:Meta%20Muffins"}]').
"#.to_string());
let result = machine.run_query(String::from("subject_class(\"Todo\", C), constructor(C, Actions)."));
assert_eq!(
result,
Ok(QueryResolution::Matches(vec![
QueryMatch::from(btreemap! {
"C" => Value::from("c"),
"Actions" => Value::from("[{action: \"addLink\", source: \"this\", predicate: \"todo://state\", target: \"todo://ready\"}]"),
}),
]))
);
let result = machine.run_query(String::from("subject_class(\"Recipe\", C), constructor(C, Actions)."));
assert_eq!(
result,
Ok(QueryResolution::Matches(vec![
QueryMatch::from(btreemap! {
"C" => Value::from("xyz"),
"Actions" => Value::from("[{action: \"addLink\", source: \"this\", predicate: \"recipe://title\", target: \"literal://string:Meta%20Muffins\"}]"),
}),
]))
);
let result = machine.run_query(String::from("subject_class(Class, _)."));
assert_eq!(
result,
Ok(QueryResolution::Matches(vec![
QueryMatch::from(btreemap! {
"Class" => Value::from("Todo")
}),
QueryMatch::from(btreemap! {
"Class" => Value::from("Recipe")
}),
]))
);
}
#[test]
fn list_results() {
let mut machine = Machine::new_lib();
machine.load_module_string(
"facts",
r#"
list([1,2,3]).
"#.to_string());
let result = machine.run_query(String::from("list(X)."));
assert_eq!(
result,
Ok(QueryResolution::Matches(vec![
QueryMatch::from(btreemap! {
"X" => Value::List(
Vec::from([
Value::Float(OrderedFloat::from(1.0)),
Value::Float(OrderedFloat::from(2.0)),
Value::Float(OrderedFloat::from(3.0))
])
)
}),
]))
);
}
#[test]
fn consult() {
let mut machine = Machine::new_lib();
machine.consult_module_string(
"facts",
String::from(
r#"
triple("a", "p1", "b").
triple("a", "p2", "b").
"#,
),
);
let query = String::from(r#"triple("a",P,"b")."#);
let output = machine.run_query(query);
assert_eq!(
output,
Ok(QueryResolution::Matches(vec![
QueryMatch::from(btreemap! {
"P" => Value::from("p1"),
}),
QueryMatch::from(btreemap! {
"P" => Value::from("p2"),
}),
]))
);
assert_eq!(
machine.run_query(String::from(r#"triple("a","p1","b")."#)),
Ok(QueryResolution::True)
);
assert_eq!(
machine.run_query(String::from(r#"triple("x","y","z")."#)),
Ok(QueryResolution::False)
);
machine.consult_module_string(
"facts",
String::from(
r#"
triple("a", "new", "b").
"#,
),
);
assert_eq!(
machine.run_query(String::from(r#"triple("a","p1","b")."#)),
Ok(QueryResolution::False)
);
assert_eq!(
machine.run_query(String::from(r#"triple("a","new","b")."#)),
Ok(QueryResolution::True)
);
}
#[ignore = "fails on windows"]
#[test]
fn stress_integration_test() {
let mut machine = Machine::new_lib();
// File with test commands, i.e. program code to consult and queries to run
let code = include_str!("./lib_integration_test_commands.txt");
// Split the code into blocks
let blocks = code.split("=====");
let mut i = 0;
// Iterate over the blocks
for block in blocks {
// Trim the block to remove any leading or trailing whitespace
let block = block.trim();
// Skip empty blocks
if block.is_empty() {
continue;
}
// Check if the block is a query
if block.starts_with("query") {
// Extract the query from the block
let query = &block[5..];
i += 1;
println!("query #{}: {}", i, query);
// Parse and execute the query
let result = machine.run_query(query.to_string());
assert!(result.is_ok());
// Print the result
println!("{:?}", result);
} else if block.starts_with("consult") {
// Extract the code from the block
let code = &block[7..];
println!("load code: {}", code);
// Load the code into the machine
machine.consult_module_string("facts", code.to_string());
}
}
}
#[test]
fn findall() {
let mut machine = Machine::new_lib();
machine.consult_module_string(
"facts",
String::from(
r#"
triple("a", "p1", "b").
triple("a", "p2", "b").
"#,
),
);
let query = String::from(r#"findall([Predicate, Target], triple(_,Predicate,Target), Result)."#);
let output = machine.run_query(query);
assert_eq!(
output,
Ok(QueryResolution::Matches(vec![
QueryMatch::from(btreemap! {
"Predicate" => Value::from("Predicate"),
"Result" => Value::List(
Vec::from([
Value::List([Value::from("p1"), Value::from("b")].into()),
Value::List([Value::from("p2"), Value::from("b")].into()),
])
),
"Target" => Value::from("Target"),
}),
]))
);
}
}

View File

@@ -9,7 +9,7 @@ use crate::parser::ast::*;
use fxhash::FxBuildHasher;
use indexmap::IndexSet;
use ref_thread_local::RefThreadLocal;
pub use ref_thread_local::RefThreadLocal;
use std::collections::VecDeque;
use std::fs::File;
@@ -63,21 +63,27 @@ fn add_op_decl_as_module_export<'a, LS: LoadState<'a>>(
match op_decl.insert_into_op_dir(wam_op_dir) {
Some(op_desc) => {
payload.retraction_info.push_record(RetractionRecord::ReplacedUserOp(
*op_decl,
op_desc,
));
payload
.retraction_info
.push_record(RetractionRecord::ReplacedUserOp(*op_decl, op_desc));
payload.module_op_exports.push((*op_decl, Some(op_desc)));
}
None => {
payload.retraction_info.push_record(RetractionRecord::AddedUserOp(*op_decl));
payload
.retraction_info
.push_record(RetractionRecord::AddedUserOp(*op_decl));
payload.module_op_exports.push((*op_decl, None));
}
}
let compilation_target = payload.compilation_target;
add_op_decl(&mut payload.retraction_info, &compilation_target, module_op_dir, op_decl);
add_op_decl(
&mut payload.retraction_info,
&compilation_target,
module_op_dir,
op_decl,
);
}
pub(super) fn add_op_decl(
@@ -89,10 +95,7 @@ pub(super) fn add_op_decl(
match op_decl.insert_into_op_dir(op_dir) {
Some(op_desc) => match &compilation_target {
CompilationTarget::User => {
retraction_info.push_record(RetractionRecord::ReplacedUserOp(
*op_decl,
op_desc,
));
retraction_info.push_record(RetractionRecord::ReplacedUserOp(*op_decl, op_desc));
}
CompilationTarget::Module(ref module_name) => {
retraction_info.push_record(RetractionRecord::ReplacedModuleOp(
@@ -107,10 +110,8 @@ pub(super) fn add_op_decl(
retraction_info.push_record(RetractionRecord::AddedUserOp(*op_decl));
}
CompilationTarget::Module(ref module_name) => {
retraction_info.push_record(RetractionRecord::AddedModuleOp(
*module_name,
*op_decl,
));
retraction_info
.push_record(RetractionRecord::AddedModuleOp(*module_name, *op_decl));
}
},
}
@@ -133,7 +134,7 @@ pub(super) fn import_module_exports<'a, LS: LoadState<'a>>(
meta_predicates.insert(key, meta_specs.clone());
}
if let Some(src_code_index) = imported_module.code_dir.get(&key) {
if let Some(src_code_index) = imported_module.code_dir.get(&key).cloned() {
let arena = &mut LS::machine_st(payload).arena;
let target_code_index = code_dir
@@ -148,6 +149,10 @@ pub(super) fn import_module_exports<'a, LS: LoadState<'a>>(
target_code_index,
src_code_index.get(),
);
if src_code_index.is_dynamic_undefined() {
code_dir.insert(key, src_code_index);
}
} else {
return Err(SessionError::ModuleDoesNotContainExport(
imported_module.module_decl.name,
@@ -156,7 +161,12 @@ pub(super) fn import_module_exports<'a, LS: LoadState<'a>>(
}
}
ModuleExport::OpDecl(ref op_decl) => {
add_op_decl(&mut payload.retraction_info, compilation_target, op_dir, op_decl);
add_op_decl(
&mut payload.retraction_info,
compilation_target,
op_dir,
op_decl,
);
}
}
}
@@ -205,12 +215,7 @@ fn import_module_exports_into_module<'a, LS: LoadState<'a>>(
}
}
ModuleExport::OpDecl(ref op_decl) => {
add_op_decl_as_module_export::<LS>(
payload,
op_dir,
wam_op_dir,
op_decl,
);
add_op_decl_as_module_export::<LS>(payload, op_dir, wam_op_dir, op_decl);
}
}
}
@@ -235,13 +240,18 @@ fn import_qualified_module_exports<'a, LS: LoadState<'a>>(
let key = (*name, *arity);
if let Some(meta_specs) = imported_module.meta_predicates.get(&key) {
wam_prelude.indices.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 arena = &mut LS::machine_st(payload).arena;
let target_code_index = wam_prelude.indices.code_dir
let target_code_index = wam_prelude
.indices
.code_dir
.entry(key.clone())
.or_insert_with(|| CodeIndex::new(IndexPtr::undefined(), arena))
.clone();
@@ -321,12 +331,7 @@ fn import_qualified_module_exports_into_module<'a, LS: LoadState<'a>>(
}
}
ModuleExport::OpDecl(ref op_decl) => {
add_op_decl_as_module_export::<LS>(
payload,
op_dir,
wam_op_dir,
op_decl,
);
add_op_decl_as_module_export::<LS>(payload, op_dir, wam_op_dir, op_decl);
}
}
}
@@ -374,10 +379,8 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
mut clause_target_poses: Vec<Option<usize>>,
is_dynamic: bool,
) {
let old_compilation_target = mem::replace(
&mut self.payload.compilation_target,
compilation_target,
);
let old_compilation_target =
mem::replace(&mut self.payload.compilation_target, compilation_target);
while let Some(target_pos_opt) = clause_target_poses.pop() {
match target_pos_opt {
@@ -441,13 +444,11 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
term: Term,
preprocessor: &mut Preprocessor,
) -> Result<PredicateClause, SessionError> {
let tl = preprocessor.try_term_to_tl(self, term, CutContext::BlocksCuts)?;
let tl = preprocessor.try_term_to_tl(self, term)?;
Ok(match tl {
TopLevel::Fact(fact) => PredicateClause::Fact(fact),
TopLevel::Rule(rule) => PredicateClause::Rule(rule),
TopLevel::Query(_) => return Err(SessionError::QueryCannotBeDefinedAsFact),
_ => unreachable!(),
TopLevel::Fact(fact, var_data) => PredicateClause::Fact(fact, var_data),
TopLevel::Rule(rule, var_data) => PredicateClause::Rule(rule, var_data),
})
}
@@ -480,7 +481,8 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
let old_index_ptr = code_index.replace(IndexPtr::undefined());
self.payload.retraction_info
self.payload
.retraction_info
.push_record(RetractionRecord::ReplacedModulePredicate(
module_name,
*key,
@@ -489,7 +491,8 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
}
for (key, skeleton) in removed_module.extensible_predicates.drain(..) {
self.payload.retraction_info
self.payload
.retraction_info
.push_record(RetractionRecord::RemovedSkeleton(
CompilationTarget::Module(module_name),
key,
@@ -497,7 +500,10 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
));
}
self.wam_prelude.indices.modules.insert(module_name, removed_module);
self.wam_prelude
.indices
.modules
.insert(module_name, removed_module);
}
pub(super) fn remove_module_exports(&mut self, module_name: Atom) {
@@ -521,15 +527,17 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
(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());
retraction_info.push_record(predicate_retractor(*key, old_index_ptr));
let old_index_ptr =
target_code_index.replace(IndexPtr::undefined());
retraction_info
.push_record(predicate_retractor(*key, old_index_ptr));
}
_ => {}
}
}
ModuleExport::OpDecl(op_decl) => {
let op_dir_value_opt =
op_dir.remove(&(op_decl.name, fixity(op_decl.op_desc.get_spec() as u32)));
let op_dir_value_opt = op_dir
.remove(&(op_decl.name, fixity(op_decl.op_desc.get_spec() as u32)));
if let Some(op_desc) = op_dir_value_opt {
retraction_info.push_record(op_retractor(*op_decl, op_desc));
@@ -550,9 +558,7 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
RetractionRecord::ReplacedUserOp,
);
}
CompilationTarget::Module(target_module_name)
if target_module_name != module_name =>
{
CompilationTarget::Module(target_module_name) if target_module_name != module_name => {
let predicate_retractor = |key, index_ptr| {
RetractionRecord::ReplacedModulePredicate(module_name, key, index_ptr)
};
@@ -561,7 +567,12 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
RetractionRecord::ReplacedModuleOp(module_name, op_decl, op_desc)
};
if let Some(module) = self.wam_prelude.indices.modules.get_mut(&target_module_name) {
if let Some(module) = self
.wam_prelude
.indices
.modules
.get_mut(&target_module_name)
{
remove_module_exports(
&removed_module,
&mut module.code_dir,
@@ -577,7 +588,10 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
CompilationTarget::Module(_) => {}
};
self.wam_prelude.indices.modules.insert(module_name, removed_module);
self.wam_prelude
.indices
.modules
.insert(module_name, removed_module);
}
fn get_or_insert_local_code_index(
@@ -589,10 +603,12 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
Some(ref mut module) => module
.code_dir
.entry(key)
.or_insert_with(|| CodeIndex::new(
IndexPtr::undefined(),
&mut LS::machine_st(&mut self.payload).arena,
))
.or_insert_with(|| {
CodeIndex::new(
IndexPtr::undefined(),
&mut LS::machine_st(&mut self.payload).arena,
)
})
.clone(),
None => {
self.add_dynamically_generated_module(module_name);
@@ -601,10 +617,12 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
Some(ref mut module) => module
.code_dir
.entry(key)
.or_insert_with(|| CodeIndex::new(
IndexPtr::undefined(),
&mut LS::machine_st(&mut self.payload).arena,
))
.or_insert_with(|| {
CodeIndex::new(
IndexPtr::undefined(),
&mut LS::machine_st(&mut self.payload).arena,
)
})
.clone(),
None => {
unreachable!()
@@ -769,10 +787,7 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
ClauseType::Named(arity, name, _) => {
let payload_compilation_target = self.payload.compilation_target;
let idx = self.get_or_insert_code_index(
(name, arity),
payload_compilation_target,
);
let idx = self.get_or_insert_code_index((name, arity), payload_compilation_target);
ClauseType::Named(arity, name, idx)
}
@@ -800,13 +815,11 @@ 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,
)
self.wam_prelude.indices.get_meta_predicate_spec(
name,
arity,
&self.payload.compilation_target,
)
}
pub(super) fn add_meta_predicate_record(
@@ -827,19 +840,18 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
.insert(key, meta_specs)
{
Some(old_meta_specs) => {
self.payload.retraction_info
.push_record(RetractionRecord::ReplacedMetaPredicate(
self.payload.retraction_info.push_record(
RetractionRecord::ReplacedMetaPredicate(
module_name,
key.0,
old_meta_specs,
));
),
);
}
None => {
self.payload.retraction_info
.push_record(RetractionRecord::AddedMetaPredicate(
module_name,
key,
));
self.payload
.retraction_info
.push_record(RetractionRecord::AddedMetaPredicate(module_name, key));
}
}
}
@@ -866,17 +878,16 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
None => {
self.add_dynamically_generated_module(module_name);
if let Some(module) = self.wam_prelude.indices.modules.get_mut(&module_name) {
if let Some(module) = self.wam_prelude.indices.modules.get_mut(&module_name)
{
module.meta_predicates.insert(key.clone(), meta_specs);
} else {
unreachable!()
}
self.payload.retraction_info
.push_record(RetractionRecord::AddedMetaPredicate(
module_name.clone(),
key,
));
self.payload.retraction_info.push_record(
RetractionRecord::AddedMetaPredicate(module_name.clone(), key),
);
}
}
}
@@ -899,10 +910,14 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
&mut module.meta_predicates,
);
self.payload.retraction_info
self.payload
.retraction_info
.push_record(RetractionRecord::AddedModule(module_name.clone()));
self.wam_prelude.indices.modules.insert(module_name.clone(), module);
self.wam_prelude
.indices
.modules
.insert(module_name.clone(), module);
}
fn import_builtins_in_module(
@@ -966,9 +981,7 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
if is_dynamic {
let clause_clause_compilation_target = match compilation_target {
CompilationTarget::User => {
CompilationTarget::Module(atom!("builtins"))
}
CompilationTarget::User => CompilationTarget::Module(atom!("builtins")),
module => module.clone(),
};
@@ -979,7 +992,8 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
}
}
self.payload.retraction_info
self.payload
.retraction_info
.push_record(RetractionRecord::ReplacedModule(
old_module_decl,
listing_src.clone(),
@@ -990,10 +1004,22 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
}
}
pub(crate) fn add_module(&mut self, module_decl: ModuleDecl, listing_src: ListingSource) {
self.reset_in_situ_module(module_decl.clone(), &listing_src);
pub(crate) fn add_module(
&mut self,
module_decl: ModuleDecl,
listing_src: ListingSource,
) -> Result<(), SessionError> {
let module_name = module_decl.name;
if let Some(module) = self.wam_prelude.indices.modules.get(&module_name) {
if let ListingSource::DynamicallyGenerated = module.listing_src {
} else {
LS::err_on_builtin_module_overwrite(module_name)?;
}
}
self.reset_in_situ_module(module_decl.clone(), &listing_src);
let mut module = match self.wam_prelude.indices.modules.remove(&module_name) {
Some(mut module) => {
module.listing_src = listing_src;
@@ -1031,6 +1057,8 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
}
self.wam_prelude.indices.modules.insert(module_name, module);
Ok(())
}
pub(super) fn import_module(&mut self, module_name: Atom) -> Result<(), SessionError> {
@@ -1049,7 +1077,12 @@ 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) {
match self
.wam_prelude
.indices
.modules
.get_mut(defining_module_name)
{
Some(ref mut target_module) => {
import_module_exports_into_module::<LS>(
&mut self.payload,
@@ -1089,17 +1122,20 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
let payload_compilation_target = self.payload.compilation_target;
let result = match &payload_compilation_target {
CompilationTarget::User => {
import_qualified_module_exports::<LS>(
&mut self.payload,
&payload_compilation_target,
&module,
&exports,
&mut self.wam_prelude,
)
}
CompilationTarget::User => import_qualified_module_exports::<LS>(
&mut self.payload,
&payload_compilation_target,
&module,
&exports,
&mut self.wam_prelude,
),
CompilationTarget::Module(ref defining_module_name) => {
match self.wam_prelude.indices.modules.get_mut(defining_module_name) {
match self
.wam_prelude
.indices
.modules
.get_mut(defining_module_name)
{
Some(ref mut target_module) => {
import_qualified_module_exports_into_module::<LS>(
&mut self.payload,
@@ -1111,9 +1147,7 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
&mut self.wam_prelude.indices.op_dir,
)
}
None => {
Err(SessionError::ModuleCannotImportSelf(module_name))
}
None => Err(SessionError::ModuleCannotImportSelf(module_name)),
}
}
};
@@ -1121,29 +1155,38 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
self.wam_prelude.indices.modules.insert(module_name, module);
result
} else {
Err(SessionError::ExistenceError(ExistenceError::Module(module_name)))
Err(SessionError::ExistenceError(ExistenceError::Module(
module_name,
)))
}
}
pub(crate) fn use_module(&mut self, module_src: ModuleSource) -> Result<(), SessionError> {
let (stream, listing_src) = match module_src {
ModuleSource::File(filename) => {
let mut path_buf = PathBuf::from(filename.as_str());
let mut path_buf = PathBuf::from(&*filename.as_str());
path_buf.set_extension("pl");
let file = File::open(&path_buf)?;
(
Stream::from_file_as_input(filename, file, &mut LS::machine_st(&mut self.payload).arena),
Stream::from_file_as_input(
filename,
file,
&mut LS::machine_st(&mut self.payload).arena,
),
ListingSource::File(filename, path_buf),
)
}
ModuleSource::Library(library) => match LIBRARIES.borrow().get(library.as_str()) {
ModuleSource::Library(library) => match LIBRARIES.borrow().get(&*library.as_str()) {
Some(code) => {
if let Some(ref module) = self.wam_prelude.indices.modules.get(&library) {
if let ListingSource::DynamicallyGenerated = &module.listing_src {
(
Stream::from_static_string(*code, &mut LS::machine_st(&mut self.payload).arena),
Stream::from_static_string(
*code,
&mut LS::machine_st(&mut self.payload).arena,
),
ListingSource::User,
)
} else {
@@ -1151,7 +1194,10 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
}
} else {
(
Stream::from_static_string(*code, &mut LS::machine_st(&mut self.payload).arena),
Stream::from_static_string(
*code,
&mut LS::machine_st(&mut self.payload).arena,
),
ListingSource::User,
)
}
@@ -1170,9 +1216,10 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
);
let subloader: Loader<'_, BootstrappingLoadState> = Loader {
payload: BootstrappingLoadState(
LoadStatePayload::new(self.wam_prelude.code.len(), term_stream)
),
payload: BootstrappingLoadState(LoadStatePayload::new(
self.wam_prelude.code.len(),
term_stream,
)),
wam_prelude: MachinePreludeView {
indices: self.wam_prelude.indices,
code: self.wam_prelude.code,
@@ -1199,22 +1246,29 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
) -> Result<(), SessionError> {
let (stream, listing_src) = match module_src {
ModuleSource::File(filename) => {
let mut path_buf = PathBuf::from(filename.as_str());
let mut path_buf = PathBuf::from(&*filename.as_str());
path_buf.set_extension("pl");
let file = File::open(&path_buf)?;
(
Stream::from_file_as_input(filename, file, &mut LS::machine_st(&mut self.payload).arena),
Stream::from_file_as_input(
filename,
file,
&mut LS::machine_st(&mut self.payload).arena,
),
ListingSource::File(filename, path_buf),
)
}
ModuleSource::Library(library) => match LIBRARIES.borrow().get(library.as_str()) {
ModuleSource::Library(library) => match LIBRARIES.borrow().get(&*library.as_str()) {
Some(code) => {
if self.wam_prelude.indices.modules.contains_key(&library) {
return self.import_qualified_module(library, exports);
} else {
(
Stream::from_static_string(*code, &mut LS::machine_st(&mut self.payload).arena),
Stream::from_static_string(
*code,
&mut LS::machine_st(&mut self.payload).arena,
),
ListingSource::User,
)
}
@@ -1233,9 +1287,10 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
);
let subloader: Loader<'_, BootstrappingLoadState> = Loader {
payload: BootstrappingLoadState(
LoadStatePayload::new(self.wam_prelude.code.len(), term_stream),
),
payload: BootstrappingLoadState(LoadStatePayload::new(
self.wam_prelude.code.len(),
term_stream,
)),
wam_prelude: MachinePreludeView {
indices: self.wam_prelude.indices,
code: self.wam_prelude.code,

File diff suppressed because it is too large Load Diff

View File

@@ -1,10 +1,14 @@
use crate::arena::*;
use crate::atom_table::*;
use crate::parser::ast::*;
#[cfg(feature = "ffi")]
use crate::ffi::FFIError;
use crate::forms::*;
use crate::machine::heap::*;
use crate::machine::loader::CompilationTarget;
use crate::machine::machine_state::*;
use crate::machine::streams::*;
use crate::machine::system_calls::BrentAlgState;
use crate::types::*;
@@ -40,7 +44,8 @@ pub(crate) enum ValidType {
InCharacter,
Integer,
List,
#[allow(unused)] Number,
#[allow(unused)]
Number,
Pair,
// PredicateIndicator,
// Variable
@@ -72,6 +77,12 @@ impl ValidType {
}
}
#[derive(Debug, Clone, Copy)]
pub(crate) enum ResourceError {
FiniteMemory(HeapCellValue),
OutOfFiles
}
pub(crate) trait TypeError {
fn type_error(self, machine_st: &mut MachineState, valid_type: ValidType) -> MachineError;
}
@@ -150,7 +161,7 @@ pub(crate) trait PermissionError {
) -> MachineError;
}
impl PermissionError for HeapCellValue {
impl PermissionError for Atom {
fn permission_error(
self,
_machine_st: &mut MachineState,
@@ -159,7 +170,47 @@ impl PermissionError for HeapCellValue {
) -> MachineError {
let stub = functor!(
atom!("permission_error"),
[atom(perm.as_atom()), atom(index_atom), cell(self)]
[atom(perm.as_atom()), atom(index_atom), cell(atom_as_cell!(self))]
);
MachineError {
stub,
location: None,
from: ErrorProvenance::Received,
}
}
}
impl PermissionError for HeapCellValue {
fn permission_error(
self,
_machine_st: &mut MachineState,
index_atom: Atom,
perm: Permission,
) -> MachineError {
let cell = read_heap_cell!(self,
(HeapCellValueTag::Cons, ptr) => {
match_untyped_arena_ptr!(ptr,
(ArenaHeaderTag::Stream, stream) => {
if let Some(alias) = stream.options().get_alias() {
atom_as_cell!(alias)
} else {
self
}
}
_ => {
self
}
)
}
_ => {
self
}
);
let stub = functor!(
atom!("permission_error"),
[atom(perm.as_atom()), atom(index_atom), cell(cell)]
);
MachineError {
@@ -230,9 +281,11 @@ pub(super) type FunctorStub = [HeapCellValue; 3];
#[inline(always)]
pub(super) fn functor_stub(name: Atom, arity: usize) -> FunctorStub {
[atom_as_cell!(atom!("/"), 2),
atom_as_cell!(name),
fixnum_as_cell!(Fixnum::build_with(arity as i64))]
[
atom_as_cell!(atom!("/"), 2),
atom_as_cell!(name),
fixnum_as_cell!(Fixnum::build_with(arity as i64)),
]
}
impl MachineState {
@@ -257,11 +310,21 @@ impl MachineState {
}
}
pub(super) fn resource_error(&mut self, value: HeapCellValue) -> MachineError {
let stub = functor!(
atom!("resource_error"),
[atom(atom!("finite_memory")), cell(value)]
);
pub(super) fn resource_error(&mut self, err: ResourceError) -> MachineError {
let stub = match err {
ResourceError::FiniteMemory(size_requested) => {
functor!(
atom!("resource_error"),
[atom(atom!("finite_memory")), cell(size_requested)]
)
}
ResourceError::OutOfFiles => {
functor!(
atom!("resource_error"),
[atom(atom!("file_descriptors"))]
)
}
};
MachineError {
stub,
@@ -278,26 +341,6 @@ impl MachineState {
culprit.type_error(self, valid_type)
}
pub(super) fn module_resolution_error(
&mut self,
mod_name: Atom,
name: Atom,
arity: usize,
) -> MachineError {
let h = self.heap.len();
let res_stub = functor!(atom!(":"), [atom(mod_name), atom(name)]);
let ind_stub = functor!(atom!("/"), [str(h + 2, 0), fixnum(arity)], [res_stub]);
let stub = functor!(atom!("evaluation_error"), [str(h, 0)], [ind_stub]);
MachineError {
stub,
location: None,
from: ErrorProvenance::Constructed,
}
}
pub(super) fn existence_error(&mut self, err: ExistenceError) -> MachineError {
match err {
ExistenceError::Module(name) => {
@@ -312,6 +355,20 @@ impl MachineState {
from: ErrorProvenance::Received,
}
}
ExistenceError::QualifiedProcedure { module_name, name, arity } => {
let h = self.heap.len();
let ind_stub = functor!(atom!("/"), [atom(name), fixnum(arity)]);
let res_stub = functor!(atom!(":"), [atom(module_name), str(h + 3, 0)], [ind_stub]);
let stub = functor!(atom!("existence_error"), [atom(atom!("procedure")), str(h, 0)], [res_stub]);
MachineError {
stub,
location: None,
from: ErrorProvenance::Constructed,
}
}
ExistenceError::Procedure(name, arity) => {
let culprit = functor!(atom!("/"), [atom(name), fixnum(arity)]);
@@ -416,17 +473,22 @@ impl MachineState {
pub(super) fn session_error(&mut self, err: SessionError) -> MachineError {
match err {
SessionError::CannotOverwriteBuiltIn(key) => {
// SessionError::CannotOverwriteImport(pred_atom) => {
self.permission_error(
Permission::Modify,
atom!("private_procedure"),
functor_stub(key.0, key.1).into_iter().collect::<MachineStub>(),
atom!("static_procedure"),
functor_stub(key.0, key.1)
.into_iter()
.collect::<MachineStub>(),
)
}
SessionError::CannotOverwriteBuiltInModule(module) => {
self.permission_error(
Permission::Modify,
atom!("static_module"),
module,
)
}
SessionError::ExistenceError(err) => self.existence_error(err),
// SessionError::InvalidFileName(filename) => {
// Self::existence_error(h, ExistenceError::Module(filename))
// }
SessionError::ModuleDoesNotContainExport(..) => {
let error_atom = atom!("module_does_not_contain_claimed_export");
@@ -447,7 +509,11 @@ impl MachineState {
}
SessionError::NamelessEntry => {
let error_atom = atom!("nameless_procedure");
self.permission_error(Permission::Create, atom!("static_procedure"), functor!(error_atom))
self.permission_error(
Permission::Create,
atom!("static_procedure"),
functor!(error_atom),
)
}
SessionError::OpIsInfixAndPostFix(op) => {
self.permission_error(Permission::Create, atom!("operator"), functor!(op))
@@ -515,6 +581,25 @@ impl MachineState {
}
}
#[cfg(feature = "ffi")]
pub(super) fn ffi_error(&mut self, err: FFIError) -> MachineError {
let error_atom = match err {
FFIError::ValueCast => atom!("value_cast"),
FFIError::ValueDontFit => atom!("value_dont_fit"),
FFIError::InvalidFFIType => atom!("invalid_ffi_type"),
FFIError::InvalidStructName => atom!("invalid_struct_name"),
FFIError::FunctionNotFound => atom!("function_not_found"),
FFIError::StructNotFound => atom!("struct_not_found"),
};
let stub = functor!(atom!("ffi_error"), [atom(error_atom)]);
MachineError {
stub,
location: None,
from: ErrorProvenance::Constructed,
}
}
pub(super) fn error_form(&mut self, err: MachineError, src: FunctorStub) -> MachineStub {
let h = self.heap.len();
let location = err.location;
@@ -639,10 +724,12 @@ impl CompilationError {
&CompilationError::ExpectedRel => {
functor!(atom!("expected_relation"))
}
&CompilationError::InadmissibleFact => { // TODO: type_error(callable, _).
&CompilationError::InadmissibleFact => {
// TODO: type_error(callable, _).
functor!(atom!("inadmissible_fact"))
}
&CompilationError::InadmissibleQueryTerm => { // TODO: type_error(callable, _).
&CompilationError::InadmissibleQueryTerm => {
// TODO: type_error(callable, _).
functor!(atom!("inadmissible_query_term"))
}
&CompilationError::InconsistentEntry => {
@@ -661,7 +748,6 @@ impl CompilationError {
functor!(atom!("no_such_module"), [atom(module_name)])
}
&CompilationError::InvalidRuleHead => {
functor!(atom!("invalid_head_of_rule")) // TODO: type_error(callable, _).
}
&CompilationError::InvalidUseModuleDecl => {
@@ -778,10 +864,10 @@ pub enum CycleSearchResult {
Cyclic(usize),
EmptyList,
NotList(usize, HeapCellValue), // the list length until the second argument in the heap
PartialList(usize, Ref), // the list length (up to max), and an offset into the heap.
ProperList(usize), // the list length.
PStrLocation(usize, usize), // list length (up to max), the heap address of the PStrOffset
UntouchedList(usize, usize), // list length (up to max), the address of an uniterated Addr::Lis(address).
PartialList(usize, Ref), // the list length (up to max), and an offset into the heap.
ProperList(usize), // the list length.
PStrLocation(usize, usize, usize), // list length (up to max), the heap address of the PStr, the offset
UntouchedList(usize, usize), // list length (up to max), the address of an uniterated Addr::Lis(address).
UntouchedCStr(Atom, usize),
}
@@ -796,7 +882,7 @@ impl MachineState {
match BrentAlgState::detect_cycles(&self.heap, list) {
CycleSearchResult::PartialList(..) => {
let err = self.instantiation_error();
return Err(self.error_form(err, stub_gen()))
return Err(self.error_form(err, stub_gen()));
}
CycleSearchResult::NotList(..) | CycleSearchResult::Cyclic(_) => {
let err = self.type_error(ValidType::List, list);
@@ -900,6 +986,7 @@ pub enum ExistenceError {
Module(Atom),
ModuleSource(ModuleSource),
Procedure(Atom, usize),
QualifiedProcedure { module_name: Atom, name: Atom, arity: usize },
SourceSink(HeapCellValue),
Stream(HeapCellValue),
}
@@ -908,6 +995,7 @@ pub enum ExistenceError {
pub enum SessionError {
CompilationError(CompilationError),
CannotOverwriteBuiltIn(PredicateKey),
CannotOverwriteBuiltInModule(Atom),
ExistenceError(ExistenceError),
ModuleDoesNotContainExport(Atom, PredicateKey),
ModuleCannotImportSelf(Atom),

View File

@@ -2,34 +2,25 @@ use crate::parser::ast::*;
use crate::arena::*;
use crate::atom_table::*;
use crate::fixtures::*;
use crate::forms::*;
use crate::machine::loader::*;
use crate::machine::machine_state::*;
use crate::machine::streams::Stream;
use crate::machine::ClauseType;
use fxhash::FxBuildHasher;
use indexmap::IndexMap;
use modular_bitfield::{BitfieldSpecifier, bitfield};
use indexmap::{IndexMap, IndexSet};
use modular_bitfield::specifiers::*;
use modular_bitfield::{bitfield, BitfieldSpecifier};
use std::cmp::Ordering;
use std::collections::BTreeSet;
use std::ops::{Deref, DerefMut};
use std::rc::Rc;
use crate::types::*;
#[derive(Debug, Clone, PartialEq, Eq, PartialOrd, Ord, Hash)]
pub(crate) struct OrderedOpDirKey(pub(crate) Atom, pub(crate) Fixity);
pub(crate) type OssifiedOpDir = IndexMap<(Atom, Fixity), (usize, Specifier)>;
#[derive(Debug, Clone, Copy, PartialEq, Eq)]
pub enum DBRef {
NamedPred(Atom, usize),
Op(Atom, Fixity, TypedArenaPtr<OssifiedOpDir>),
}
// 7.2
#[derive(Debug, Clone, Copy, PartialEq, Eq, PartialOrd, Ord)]
pub enum TermOrderCategory {
@@ -87,7 +78,8 @@ pub enum IndexPtrTag {
#[derive(Debug, Clone, Copy, Eq, Hash, Ord, PartialEq, PartialOrd)]
pub struct IndexPtr {
pub p: B56,
#[allow(unused)] m: bool,
#[allow(unused)]
m: bool,
pub tag: IndexPtrTag,
}
@@ -144,6 +136,10 @@ impl IndexPtr {
#[derive(Debug, Clone, Copy, Ord, Hash, PartialOrd, Eq, PartialEq)]
pub struct CodeIndex(TypedArenaPtr<IndexPtr>);
#[cfg(target_pointer_width = "32")]
const_assert!(std::mem::align_of::<CodeIndex>() == 4);
#[cfg(target_pointer_width = "64")]
const_assert!(std::mem::align_of::<CodeIndex>() == 8);
impl Deref for CodeIndex {
@@ -165,7 +161,7 @@ impl DerefMut for CodeIndex {
impl From<CodeIndex> for UntypedArenaPtr {
#[inline(always)]
fn from(ptr: CodeIndex) -> UntypedArenaPtr {
unsafe { std::mem::transmute(ptr.0.as_ptr()) }
UntypedArenaPtr::build_with(ptr.0.as_ptr() as usize)
}
}
@@ -228,8 +224,32 @@ impl CodeIndex {
}
}
pub(crate) type HeapVarDict = IndexMap<Rc<String>, HeapCellValue, FxBuildHasher>;
pub(crate) type AllocVarDict = IndexMap<Rc<String>, VarData, FxBuildHasher>;
#[derive(Debug, Clone, PartialEq, Eq, Hash)]
pub enum VarKey {
AnonVar(usize),
VarPtr(VarPtr),
}
impl VarKey {
#[inline]
pub(crate) fn to_string(&self) -> String {
match self {
VarKey::AnonVar(h) => format!("_{}", h),
VarKey::VarPtr(var) => var.borrow().to_string(),
}
}
#[inline(always)]
pub(crate) fn is_anon(&self) -> bool {
if let VarKey::AnonVar(_) = self {
true
} else {
false
}
}
}
pub(crate) type HeapVarDict = IndexMap<VarKey, HeapCellValue, FxBuildHasher>;
pub(crate) type GlobalVarDir = IndexMap<Atom, (Ball, Option<HeapCellValue>), FxBuildHasher>;
@@ -245,12 +265,15 @@ pub(crate) type LocalExtensiblePredicates =
pub(crate) type CodeDir = IndexMap<PredicateKey, CodeIndex, FxBuildHasher>;
pub(crate) type GoalExpansionIndices = IndexSet<PredicateKey, FxBuildHasher>;
#[derive(Debug)]
pub struct IndexStore {
pub(super) code_dir: CodeDir,
pub(super) extensible_predicates: ExtensiblePredicates,
pub(super) local_extensible_predicates: LocalExtensiblePredicates,
pub(super) global_variables: GlobalVarDir,
pub(super) goal_expansion_indices: GoalExpansionIndices,
pub(super) meta_predicates: MetaPredicateDir,
pub(super) modules: ModuleDir,
pub(super) op_dir: OpDir,
@@ -259,6 +282,24 @@ pub struct IndexStore {
}
impl IndexStore {
pub(crate) fn builtin_property(&self, key: PredicateKey) -> bool {
let (name, arity) = key;
if !ClauseType::is_inbuilt(name, arity) {
self.modules
.get(&(atom!("builtins")))
.map(|module| module.code_dir.contains_key(&(name, arity)))
.unwrap_or(false)
} else {
true
}
}
#[inline(always)]
pub(crate) fn goal_expansion_defined(&self, key: PredicateKey) -> bool {
self.goal_expansion_indices.contains(&key)
}
pub(crate) fn get_predicate_skeleton_mut(
&mut self,
compilation_target: &CompilationTarget,
@@ -371,22 +412,11 @@ 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,
}*/
} else {
self.modules
.get(&module)
.and_then(|module|/* |module| match ClauseType::from(name, arity) {
ClauseType::Named(arity, name, _) => { */
module.code_dir.get(&(name, arity)).cloned()
/*
}
_ => None,
} */
)
.and_then(|module| module.code_dir.get(&(name, arity)).cloned())
}
}
@@ -408,11 +438,7 @@ impl IndexStore {
}
}
pub(crate) fn is_dynamic_predicate(
&self,
module_name: Atom,
key: PredicateKey,
) -> bool {
pub(crate) fn is_dynamic_predicate(&self, module_name: Atom, key: PredicateKey) -> bool {
match module_name {
atom!("user") => self
.extensible_predicates

View File

@@ -3,7 +3,6 @@ use crate::atom_table::*;
use crate::forms::*;
use crate::heap_iter::*;
use crate::heap_print::*;
use crate::machine::Machine;
use crate::machine::attributed_variables::*;
use crate::machine::copier::*;
use crate::machine::heap::*;
@@ -11,17 +10,19 @@ use crate::machine::machine_errors::*;
use crate::machine::machine_indices::*;
use crate::machine::stack::*;
use crate::machine::streams::*;
use crate::machine::Machine;
use crate::parser::ast::*;
use crate::read::TermWriteResult;
use crate::types::*;
use crate::parser::rug::Integer;
use crate::parser::dashu::Integer;
use indexmap::IndexMap;
use std::convert::TryFrom;
use std::fmt;
use std::ops::{Index, IndexMut};
use std::rc::Rc;
use std::sync::Arc;
pub(crate) type Registers = [HeapCellValue; MAX_ARITY + 1];
@@ -50,15 +51,21 @@ pub enum FirstOrNext {
Next,
}
#[derive(Debug)]
pub enum OnEOF {
Return,
Continue,
}
pub struct MachineState {
pub atom_tbl: AtomTable,
pub atom_tbl: Arc<AtomTable>,
pub arena: Arena,
pub(super) pdl: Vec<HeapCellValue>,
pub(super) s: HeapPtr,
pub(super) s_offset: usize,
pub(super) p: usize,
pub(super) oip: u32, // first internal code ptr
pub(super) iip : u32, // second internal code ptr
pub(super) iip: u32, // second internal code ptr
pub(super) b: usize,
pub(super) b0: usize,
pub(super) e: usize,
@@ -73,12 +80,13 @@ pub struct MachineState {
pub(super) trail: Vec<TrailEntry>,
pub(super) tr: usize,
pub(super) hb: usize,
pub(super) block: usize, // an offset into the OR stack.
pub(super) block: usize, // an offset into the OR stack.
pub(super) scc_block: usize, // an offset into the OR stack for setup_call_cleanup/3.
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.
// locations of cleaners, cut points, the previous scc_block. for setup_call_cleanup/3.
pub(super) cont_pts: Vec<(HeapCellValue, usize, usize)>,
pub(super) cwil: CWIL,
pub(crate) flags: MachineFlags,
@@ -88,7 +96,7 @@ pub struct MachineState {
pub(crate) unify_fn: fn(&mut MachineState),
pub(crate) bind_fn: fn(&mut MachineState, Ref, HeapCellValue),
pub(crate) run_cleaners_fn: fn(&mut Machine) -> bool,
pub(crate) increment_call_count_fn: fn(&mut MachineState) -> CallResult,
pub(crate) increment_call_count_fn: fn(&mut MachineState) -> bool,
}
impl fmt::Debug for MachineState {
@@ -113,6 +121,7 @@ impl fmt::Debug for MachineState {
.field("tr", &self.tr)
.field("hb", &self.hb)
.field("block", &self.block)
.field("scc_block", &self.scc_block)
.field("ball", &self.ball)
.field("ball_stack", &self.ball_stack)
.field("lifted_heap", &self.lifted_heap)
@@ -192,6 +201,27 @@ pub fn pstr_loc_and_offset(heap: &[HeapCellValue], index: usize) -> (usize, Fixn
)
}
fn push_var_eq_functors<'a>(
heap: &mut Heap,
iter: impl Iterator<Item = (&'a VarKey, &'a HeapCellValue)>,
atom_tbl: &AtomTable,
) -> Vec<HeapCellValue> {
let mut list_of_var_eqs = vec![];
for (var, binding) in iter {
let var_atom = AtomTable::build_with(atom_tbl, &var.to_string());
let h = heap.len();
heap.push(atom_as_cell!(atom!("="), 2));
heap.push(atom_as_cell!(var_atom));
heap.push(*binding);
list_of_var_eqs.push(str_loc_as_cell!(h));
}
list_of_var_eqs
}
#[derive(Debug)]
pub struct Ball {
pub(super) boundary: usize,
@@ -214,9 +244,11 @@ impl Ball {
pub(super) fn copy_and_align(&self, h: usize) -> Heap {
let diff = self.boundary as i64 - h as i64;
self.stub.iter().cloned().map(|heap_value| {
heap_value - diff
}).collect()
self.stub
.iter()
.cloned()
.map(|heap_value| heap_value - diff)
.collect()
}
}
@@ -380,28 +412,31 @@ impl MachineState {
self.fail = false;
}
pub(crate) fn increment_call_count(&mut self) -> CallResult {
pub(crate) fn increment_call_count(&mut self) -> bool {
if self.cwil.inference_limit_exceeded || self.ball.stub.len() > 0 {
return Ok(());
return true;
}
if let Some(&(ref limit, bp)) = self.cwil.limits.last() {
if let Some(&(ref limit, block)) = self.cwil.limits.last() {
if self.cwil.count == *limit {
self.cwil.inference_limit_exceeded = true;
self.block = block;
self.unwind_stack();
return Err(
functor!(atom!("inference_limit_exceeded"), [fixnum(bp)])
);
return false;
} else {
self.cwil.count += 1;
}
}
Ok(())
true
}
#[allow(dead_code)]
pub(super) fn try_char_list(&mut self, addrs: Vec<HeapCellValue>) -> Result<String, MachineError> {
pub(super) fn try_char_list(
&mut self,
addrs: Vec<HeapCellValue>,
) -> Result<String, MachineError> {
let mut chars = String::new();
for addr in addrs {
@@ -481,45 +516,197 @@ impl MachineState {
}
}
pub fn write_read_term_options(
&mut self,
mut var_list: Vec<(VarKey, HeapCellValue, usize)>,
singleton_var_list: Vec<HeapCellValue>,
) -> CallResult {
var_list.sort_by(|(_, _, idx_1), (_, _, idx_2)| idx_1.cmp(idx_2));
let list_of_var_eqs = push_var_eq_functors(
&mut self.heap,
var_list.iter().filter_map(|(var_name, var, _)| {
if var_name.is_anon() {
None
} else {
Some((var_name, var))
}
}),
&self.atom_tbl,
);
let singleton_addr = self.registers[3];
let singletons_offset = heap_loc_as_cell!(iter_to_heap_list(
&mut self.heap,
singleton_var_list.into_iter()
));
unify_fn!(*self, singletons_offset, singleton_addr);
if self.fail {
return Ok(());
}
let vars_addr = self.registers[4];
let vars_offset = heap_loc_as_cell!(iter_to_heap_list(
&mut self.heap,
var_list.into_iter().map(|(_, cell, _)| cell)
));
unify_fn!(*self, vars_offset, vars_addr);
if self.fail {
return Ok(());
}
let var_names_addr = self.registers[5];
let var_names_offset = heap_loc_as_cell!(iter_to_heap_list(
&mut self.heap,
list_of_var_eqs.into_iter()
));
Ok(unify_fn!(*self, var_names_offset, var_names_addr))
}
pub fn read_term_body(&mut self, mut term_write_result: TermWriteResult) -> CallResult {
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)
}
_ => {
heap_loc_as_cell!(term_write_result.heap_loc)
}
);
unify_fn!(*self, heap_loc, self.registers[2]);
if self.fail {
return Ok(());
}
for var in term_write_result.var_dict.values_mut() {
*var = heap_bound_deref(&self.heap, *var);
}
let mut singleton_var_set: IndexMap<Ref, bool> = IndexMap::new();
for cell in stackful_preorder_iter::<NonListElider>(&mut self.heap, &mut self.stack, heap_loc) {
let cell = unmark_cell_bits!(cell);
if let Some(var) = cell.as_var() {
if !singleton_var_set.contains_key(&var) {
singleton_var_set.insert(var, true);
} else {
singleton_var_set.insert(var, false);
}
}
}
let singleton_var_list = push_var_eq_functors(
&mut self.heap,
term_write_result
.var_dict
.iter()
.filter(|(var_name, binding)| {
if var_name.is_anon() {
return false;
}
if let Some(r) = binding.as_var() {
*singleton_var_set.get(&r).unwrap_or(&false)
} else {
false
}
}),
&self.atom_tbl,
);
for var in term_write_result.var_dict.values_mut() {
*var = heap_bound_deref(&self.heap, *var);
}
let mut var_list = Vec::with_capacity(singleton_var_set.len());
for (var_name, addr) in term_write_result.var_dict {
if let Some(var) = addr.as_var() {
if let Some(idx) = singleton_var_set.get_index_of(&var) {
var_list.push((var_name, addr, idx));
}
}
}
self.write_read_term_options(var_list, singleton_var_list)
}
pub fn read_term_from_user_input_eof_handler(
&mut self,
stream: Stream,
) -> Result<OnEOF, MachineStub> {
self.eof_action(self.registers[2], stream, atom!("read_term"), 3)?;
if stream.options().eof_action() == EOFAction::Reset {
if self.fail == false {
return Ok(OnEOF::Continue);
}
}
Ok(OnEOF::Return)
}
// 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 {
let atoms_ptr = (&self.atom_tbl.table) as *const indexmap::IndexSet<Atom>;
pub fn read_term_from_user_input(
&mut self,
stream: Stream,
indices: &mut IndexStore,
) -> CallResult {
if let Stream::Readline(ptr) = stream {
unsafe {
let readline = ptr.as_ptr().as_mut().unwrap();
readline.set_atoms_for_completion(atoms_ptr);
let ret = self.read_term(stream, indices);
return ret
readline.set_atoms_for_completion(&self.atom_tbl);
return self.read_term(
stream,
indices,
MachineState::read_term_from_user_input_eof_handler,
);
}
}
if let Stream::Byte(_) = stream {
return self.read_term(
stream,
indices,
MachineState::read_term_from_user_input_eof_handler
)
}
unreachable!("Stream must be a Stream::Readline(_)")
}
pub fn read_term(&mut self, stream: Stream, indices: &mut IndexStore) -> CallResult {
fn push_var_eq_functors<'a>(
heap: &mut Heap,
iter: impl Iterator<Item = (&'a Rc<String>, &'a HeapCellValue)>,
atom_tbl: &mut AtomTable,
) -> Vec<HeapCellValue> {
let mut list_of_var_eqs = vec![];
pub fn read_term_eof_handler(&mut self, mut stream: Stream) -> Result<OnEOF, MachineStub> {
if stream.at_end_of_stream() {
unify!(self, self.registers[2], atom_as_cell!(atom!("end_of_file")));
stream.set_past_end_of_stream(true);
return Ok(OnEOF::Return);
} else if stream.past_end_of_stream() {
self.eof_action(self.registers[2], stream, atom!("read_term"), 3)?;
for (var, binding) in iter {
let var_atom = atom_tbl.build_with(&var);
let h = heap.len();
heap.push(atom_as_cell!(atom!("="), 2));
heap.push(atom_as_cell!(var_atom));
heap.push(*binding);
list_of_var_eqs.push(str_loc_as_cell!(h));
if stream.options().eof_action() == EOFAction::Reset {
if self.fail == false {
return Ok(OnEOF::Continue);
}
}
list_of_var_eqs
}
Ok(OnEOF::Return)
}
pub fn read_term(
&mut self,
stream: Stream,
indices: &mut IndexStore,
eof_handler: impl Fn(&mut Self, Stream) -> Result<OnEOF, MachineStub>,
) -> CallResult {
self.check_stream_properties(
stream,
StreamType::Text,
@@ -538,116 +725,18 @@ impl MachineState {
loop {
match self.read(stream, &indices.op_dir) {
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)
}
_ => {
heap_loc_as_cell!(term_write_result.heap_loc)
}
);
let term = self.registers[2];
unify_fn!(*self, heap_loc, term);
let term = heap_loc;
if self.fail {
return Ok(());
}
let mut singleton_var_set: IndexMap<Ref, bool> = IndexMap::new();
for addr in stackful_preorder_iter(&mut self.heap, term) {
let addr = unmark_cell_bits!(addr);
if let Some(var) = addr.as_var() {
if !singleton_var_set.contains_key(&var) {
singleton_var_set.insert(var, true);
} else {
singleton_var_set.insert(var, false);
}
}
}
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)| {
if let Some(r) = binding.as_var() {
*singleton_var_set.get(&r).unwrap_or(&false)
} else {
false
}
}),
&mut self.atom_tbl,
);
let mut var_list = Vec::with_capacity(singleton_var_set.len());
for (var_name, addr) in term_write_result.var_dict {
if let Some(var) = addr.as_var() {
let idx = singleton_var_set.get_index_of(&var).unwrap();
var_list.push((var_name, addr, idx));
}
}
var_list.sort_by(|(_,_,idx_1),(_,_,idx_2)| idx_1.cmp(idx_2));
let list_of_var_eqs = push_var_eq_functors(
&mut self.heap,
var_list.iter().map(|(var_name, var,_)| (var_name,var)),
&mut self.atom_tbl,
);
let singleton_addr = self.registers[3];
let singletons_offset = heap_loc_as_cell!(
iter_to_heap_list(&mut self.heap, singleton_var_list.into_iter())
);
unify_fn!(*self, singletons_offset, singleton_addr);
if self.fail {
return Ok(());
}
let vars_addr = self.registers[4];
let vars_offset = heap_loc_as_cell!(
iter_to_heap_list(&mut self.heap, var_list.into_iter().map(|(_,cell,_)| cell))
);
unify_fn!(*self, vars_offset, vars_addr);
if self.fail {
return Ok(());
}
let var_names_addr = self.registers[5];
let var_names_offset = heap_loc_as_cell!(
iter_to_heap_list(&mut self.heap, list_of_var_eqs.into_iter())
);
return Ok(unify_fn!(*self, var_names_offset, var_names_addr));
}
Ok(term_write_result) => return self.read_term_body(term_write_result),
Err(err) => {
if let CompilationError::ParserError(ParserError::UnexpectedEOF) = err {
self.eof_action(
self.registers[2],
stream,
atom!("read_term"),
3,
)?;
if stream.options().eof_action() == EOFAction::Reset {
if self.fail == false {
continue;
match &err {
CompilationError::ParserError(e) if e.is_unexpected_eof() => {
match eof_handler(self, stream)? {
OnEOF::Return => {
return self.write_read_term_options(vec![], vec![])
}
OnEOF::Continue => continue,
}
}
return Ok(());
_ => {}
}
let stub = functor_stub(atom!("read_term"), 3);
@@ -667,13 +756,14 @@ impl MachineState {
let numbervars = self.store(self.deref(self.registers[4]));
let quoted = self.store(self.deref(self.registers[5]));
let max_depth = self.store(self.deref(self.registers[7]));
let double_quotes = self.store(self.deref(self.registers[8]));
let term_to_be_printed = self.store(self.deref(self.registers[2]));
let stub_gen = || functor_stub(atom!("write_term"), 2);
let printer = match self.try_from_list(self.registers[6], stub_gen) {
Ok(addrs) => {
let mut var_names: IndexMap<HeapCellValue, Rc<String>> = IndexMap::new();
let mut var_names: IndexMap<HeapCellValue, VarPtr> = IndexMap::new();
for addr in addrs {
read_heap_cell!(addr,
@@ -691,18 +781,18 @@ impl MachineState {
read_heap_cell!(atom,
(HeapCellValueTag::Char, c) => {
var_names.insert(var, Rc::new(c.to_string()));
var_names.insert(var, VarPtr::from(c.to_string()));
}
(HeapCellValueTag::Atom, (name, _arity)) => {
debug_assert_eq!(_arity, 0);
var_names.insert(var, Rc::new(name.as_str().to_owned()));
var_names.insert(var, VarPtr::from(&*name.as_str()));
}
(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()));
var_names.insert(var, VarPtr::from(&*name.as_str()));
}
_ => {
unreachable!();
@@ -748,7 +838,25 @@ impl MachineState {
);
let quoted = read_heap_cell!(quoted,
(HeapCellValueTag::Atom, (name, _arity)) => {
(HeapCellValueTag::Atom, (name, arity)) => {
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!()
}
);
let double_quotes = read_heap_cell!(double_quotes,
(HeapCellValueTag::Atom, (name, arity)) => {
debug_assert_eq!(arity, 0);
name == atom!("true")
}
(HeapCellValueTag::Str, s) => {
@@ -765,6 +873,8 @@ impl MachineState {
let mut printer = HCPrinter::new(
&mut self.heap,
Arc::clone(&self.atom_tbl),
&mut self.stack,
op_dir,
PrinterOutputter::new(),
term_to_be_printed,
@@ -773,6 +883,7 @@ impl MachineState {
printer.ignore_ops = ignore_ops;
printer.numbervars = numbervars;
printer.quoted = quoted;
printer.double_quotes = double_quotes;
match Number::try_from(max_depth) {
Ok(Number::Fixnum(n)) => {
@@ -784,8 +895,10 @@ impl MachineState {
}
}
Ok(Number::Integer(n)) => {
if let Some(n) = n.to_usize() {
printer.max_depth = n;
let result = (&*n).try_into();
if let Ok(value) = result {
printer.max_depth = value;
} else {
self.fail = true;
return Ok(None);
@@ -808,7 +921,11 @@ impl MachineState {
Ok(Some(printer))
}
pub(super) fn read_predicate_key(&self, name: HeapCellValue, arity: HeapCellValue) -> (Atom, usize) {
pub(super) fn read_predicate_key(
&self,
name: HeapCellValue,
arity: HeapCellValue,
) -> (Atom, usize) {
let name = cell_as_atom!(self.store(self.deref(name)));
let arity = cell_as_fixnum!(self.store(self.deref(arity)));
@@ -820,7 +937,7 @@ impl MachineState {
let b = self.b;
read_heap_cell!(value,
(HeapCellValueTag::Fixnum, b0) => {
(HeapCellValueTag::CutPoint, b0) => {
let b0 = b0.get_num() as usize;
if b > b0 {
@@ -834,60 +951,22 @@ impl MachineState {
}
#[inline(always)]
pub(super) fn try_me_else(&mut self, offset: usize) {
let n = self.num_of_args;
let b = self.stack.allocate_or_frame(n);
let or_frame = self.stack.index_or_frame_mut(b);
pub(super) fn cut_prev_body(&mut self, value: HeapCellValue) {
let b = self.b;
or_frame.prelude.univ_prelude.num_cells = n;
or_frame.prelude.e = self.e;
or_frame.prelude.cp = self.cp;
or_frame.prelude.b = self.b;
or_frame.prelude.bp = self.p + offset;
or_frame.prelude.boip = 0;
or_frame.prelude.biip = 0;
or_frame.prelude.tr = self.tr;
or_frame.prelude.h = self.heap.len();
or_frame.prelude.b0 = self.b0;
read_heap_cell!(value,
(HeapCellValueTag::CutPoint, b0) => {
let b0 = b0.get_num() as usize;
let b0 = self.stack.index_or_frame(b0).prelude.b;
self.b = b;
for i in 0..n {
or_frame[i] = self.registers[i+1];
}
self.hb = self.heap.len();
self.p += 1;
}
#[inline(always)]
pub(super) fn indexed_try(&mut self, offset: usize) {
let n = self.num_of_args;
let b = self.stack.allocate_or_frame(n);
let or_frame = self.stack.index_or_frame_mut(b);
or_frame.prelude.univ_prelude.num_cells = n;
or_frame.prelude.e = self.e;
or_frame.prelude.cp = self.cp;
or_frame.prelude.b = self.b;
or_frame.prelude.bp = self.p; // + 1; in self.iip now!
or_frame.prelude.boip = self.oip;
or_frame.prelude.biip = self.iip + 1;
or_frame.prelude.tr = self.tr;
or_frame.prelude.h = self.heap.len();
or_frame.prelude.b0 = self.b0;
self.b = b;
for i in 0..n {
or_frame[i] = self.registers[i+1];
}
self.hb = self.heap.len();
self.p = self.p + offset;
self.oip = 0;
self.iip = 0;
if b > b0 {
self.b = b0;
}
}
_ => {
self.fail = true;
}
);
}
}
@@ -895,7 +974,7 @@ impl MachineState {
pub(crate) struct CWIL {
count: Integer,
limits: Vec<(Integer, usize)>,
inference_limit_exceeded: bool,
pub(crate) inference_limit_exceeded: bool,
}
impl CWIL {
@@ -907,22 +986,22 @@ impl CWIL {
}
}
pub(crate) fn add_limit(&mut self, limit: usize, b: usize) -> &Integer {
pub(crate) fn add_limit(&mut self, limit: usize, block: usize) -> &Integer {
let mut limit = Integer::from(limit);
limit += &self.count;
match self.limits.last() {
Some((ref inner_limit, _)) if *inner_limit <= limit => {}
_ => self.limits.push((limit, b)),
_ => self.limits.push((limit, block)),
};
&self.count
}
#[inline(always)]
pub(crate) fn remove_limit(&mut self, b: usize) -> &Integer {
if let Some((_, bp)) = self.limits.last() {
if bp == &b {
pub(crate) fn remove_limit(&mut self, block: usize) -> &Integer {
if let Some((_, bl)) = self.limits.last() {
if bl == &block {
self.limits.pop();
}
}

File diff suppressed because it is too large Load Diff

View File

@@ -2,15 +2,16 @@ pub use crate::arena::*;
pub use crate::atom_table::*;
use crate::heap_print::*;
pub use crate::machine::heap::*;
pub use crate::machine::*;
pub use crate::machine::machine_state::*;
pub use crate::machine::stack::*;
pub use crate::machine::streams::*;
pub use crate::macros::*;
pub use crate::machine::*;
pub use crate::parser::ast::*;
use crate::read::*;
pub use crate::types::*;
use std::sync::Arc;
#[cfg(test)]
use crate::machine::copier::CopierTarget;
@@ -61,6 +62,8 @@ impl MockWAM {
let mut printer = HCPrinter::new(
&mut self.machine_st.heap,
Arc::clone(&self.machine_st.atom_tbl),
&mut self.machine_st.stack,
&self.op_dir,
PrinterOutputter::new(),
heap_loc_as_cell!(term_write_result.heap_loc),
@@ -69,7 +72,10 @@ impl MockWAM {
printer.var_names = term_write_result
.var_dict
.into_iter()
.map(|(var, cell)| (cell, var))
.map(|(var, cell)| match var {
VarKey::VarPtr(var) => (cell, var.clone()),
VarKey::AnonVar(_) => (cell, VarPtr::from(var.to_string())),
})
.collect();
Ok(printer.print().result())
@@ -215,109 +221,10 @@ pub(crate) fn parse_and_write_parsed_term_to_heap(
impl Machine {
pub fn with_test_streams() -> Self {
use ref_thread_local::RefThreadLocal;
let mut machine_st = MachineState::new();
let user_input = Stream::Null(StreamOptions::default());
let user_output = Stream::from_owned_string("".to_owned(), &mut machine_st.arena);
let user_error = Stream::stderr(&mut machine_st.arena);
let runtime = tokio::runtime::Builder::new_current_thread()
.enable_all()
.build()
.unwrap();
let mut wam = Machine {
machine_st,
indices: IndexStore::new(),
code: Code::new(),
user_input,
user_output,
user_error,
load_contexts: vec![],
runtime
};
let mut lib_path = current_dir();
lib_path.pop();
lib_path.push("lib");
wam.add_impls_to_indices();
bootstrapping_compile(
Stream::from_static_string(
LIBRARIES.borrow()["ops_and_meta_predicates"],
&mut wam.machine_st.arena,
),
&mut wam,
ListingSource::from_file_and_path(
atom!("ops_and_meta_predicates.pl"),
lib_path.clone(),
),
)
.unwrap();
bootstrapping_compile(
Stream::from_static_string(
LIBRARIES.borrow()["builtins"],
&mut wam.machine_st.arena,
),
&mut wam,
ListingSource::from_file_and_path(atom!("builtins.pl"), lib_path.clone()),
)
.unwrap();
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,
&CompilationTarget::User,
builtins,
);
import_builtin_impls(&wam.indices.code_dir, builtins);
} else {
unreachable!()
}
lib_path.pop(); // remove the "lib" at the end
bootstrapping_compile(
Stream::from_static_string(include_str!("../loader.pl"), &mut wam.machine_st.arena),
&mut wam,
ListingSource::from_file_and_path(atom!("loader.pl"), lib_path.clone()),
)
.unwrap();
wam.configure_modules();
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,
&CompilationTarget::User,
loader,
);
} else {
unreachable!()
}
wam.load_special_forms();
wam.load_top_level();
wam.configure_streams();
wam
Machine::new(MachineConfig::in_memory())
}
pub fn test_load_file(&mut self, file: &str) -> Vec<u8> {
use std::io::Read;
let stream = Stream::from_owned_string(
std::fs::read_to_string(AsRef::<std::path::Path>::as_ref(file)).unwrap(),
&mut self.machine_st.arena,
@@ -326,6 +233,17 @@ impl Machine {
self.load_file(file.into(), stream);
self.user_output.bytes().map(|b| b.unwrap()).collect()
}
pub fn test_load_string(&mut self, code: &str) -> Vec<u8> {
let stream = Stream::from_owned_string(
code.to_owned(),
&mut self.machine_st.arena,
);
self.load_file("<stdin>".into(), stream);
self.user_output.bytes().map(|b| b.unwrap()).collect()
}
}
#[cfg(test)]
@@ -337,26 +255,11 @@ mod tests {
let mut wam = MachineState::new();
let mut op_dir = default_op_dir();
op_dir.insert(
(atom!("+"), Fixity::In),
OpDesc::build_with(500, YFX as u8),
);
op_dir.insert(
(atom!("-"), Fixity::In),
OpDesc::build_with(500, YFX as u8),
);
op_dir.insert(
(atom!("*"), Fixity::In),
OpDesc::build_with(500, YFX as u8),
);
op_dir.insert(
(atom!("/"), Fixity::In),
OpDesc::build_with(400, YFX as u8),
);
op_dir.insert(
(atom!("="), Fixity::In),
OpDesc::build_with(700, XFX as u8),
);
op_dir.insert((atom!("+"), Fixity::In), OpDesc::build_with(500, YFX as u8));
op_dir.insert((atom!("-"), Fixity::In), OpDesc::build_with(500, YFX as u8));
op_dir.insert((atom!("*"), Fixity::In), OpDesc::build_with(500, YFX as u8));
op_dir.insert((atom!("/"), Fixity::In), OpDesc::build_with(400, YFX as u8));
op_dir.insert((atom!("="), Fixity::In), OpDesc::build_with(700, XFX as u8));
{
parse_and_write_parsed_term_to_heap(&mut wam, "f(X,X).", &op_dir).unwrap();
@@ -573,22 +476,10 @@ mod tests {
let mut wam = MachineState::new();
let mut op_dir = default_op_dir();
op_dir.insert(
(atom!("+"), Fixity::In),
OpDesc::build_with(500, YFX as u8),
);
op_dir.insert(
(atom!("-"), Fixity::In),
OpDesc::build_with(500, YFX as u8),
);
op_dir.insert(
(atom!("*"), Fixity::In),
OpDesc::build_with(400, YFX as u8),
);
op_dir.insert(
(atom!("/"), Fixity::In),
OpDesc::build_with(400, YFX as u8),
);
op_dir.insert((atom!("+"), Fixity::In), OpDesc::build_with(500, YFX as u8));
op_dir.insert((atom!("-"), Fixity::In), OpDesc::build_with(500, YFX as u8));
op_dir.insert((atom!("*"), Fixity::In), OpDesc::build_with(400, YFX as u8));
op_dir.insert((atom!("/"), Fixity::In), OpDesc::build_with(400, YFX as u8));
{
parse_and_write_parsed_term_to_heap(&mut wam, "f(X,X).", &op_dir).unwrap();
@@ -679,20 +570,12 @@ mod tests {
wam.heap.push(heap_loc_as_cell!(1));
assert_eq!(
compare_term_test!(
wam,
heap_loc_as_cell!(0),
heap_loc_as_cell!(0)
),
compare_term_test!(wam, heap_loc_as_cell!(0), heap_loc_as_cell!(0)),
Some(Ordering::Equal)
);
assert_eq!(
compare_term_test!(
wam,
heap_loc_as_cell!(0),
atom_as_cell!(atom!("a"))
),
compare_term_test!(wam, heap_loc_as_cell!(0), atom_as_cell!(atom!("a"))),
Some(Ordering::Greater)
);
@@ -715,29 +598,17 @@ mod tests {
wam.heap.push(empty_list_as_cell!());
assert_eq!(
compare_term_test!(
wam,
heap_loc_as_cell!(7),
heap_loc_as_cell!(7)
),
compare_term_test!(wam, heap_loc_as_cell!(7), heap_loc_as_cell!(7)),
Some(Ordering::Equal)
);
assert_eq!(
compare_term_test!(
wam,
heap_loc_as_cell!(0),
heap_loc_as_cell!(7)
),
compare_term_test!(wam, heap_loc_as_cell!(0), heap_loc_as_cell!(7)),
Some(Ordering::Greater)
);
assert_eq!(
compare_term_test!(
wam,
empty_list_as_cell!(),
heap_loc_as_cell!(7)
),
compare_term_test!(wam, empty_list_as_cell!(), heap_loc_as_cell!(7)),
Some(Ordering::Less)
);
@@ -760,40 +631,24 @@ mod tests {
);
assert_eq!(
compare_term_test!(
wam,
empty_list_as_cell!(),
atom_as_cell!(atom!("atom"))
),
compare_term_test!(wam, empty_list_as_cell!(), atom_as_cell!(atom!("atom"))),
Some(Ordering::Less)
);
assert_eq!(
compare_term_test!(
wam,
atom_as_cell!(atom!("atom")),
empty_list_as_cell!()
),
compare_term_test!(wam, atom_as_cell!(atom!("atom")), empty_list_as_cell!()),
Some(Ordering::Greater)
);
let one_p_one = HeapCellValue::from(float_alloc!(1.1, &mut wam.arena));
assert_eq!(
compare_term_test!(
wam,
one_p_one,
fixnum_as_cell!(Fixnum::build_with(1))
),
compare_term_test!(wam, one_p_one, fixnum_as_cell!(Fixnum::build_with(1))),
Some(Ordering::Less)
);
assert_eq!(
compare_term_test!(
wam,
fixnum_as_cell!(Fixnum::build_with(1)),
one_p_one
),
compare_term_test!(wam, fixnum_as_cell!(Fixnum::build_with(1)), one_p_one),
Some(Ordering::Greater)
);
}
@@ -812,7 +667,8 @@ mod tests {
all_cells_unmarked(&wam.heap);
wam.heap.clear();
wam.heap.extend(functor!(atom!("f"), [atom(atom!("a")), atom(atom!("b"))]));
wam.heap
.extend(functor!(atom!("f"), [atom(atom!("a")), atom(atom!("b"))]));
assert!(!wam.is_cyclic_term(str_loc_as_cell!(0)));

File diff suppressed because it is too large Load Diff

View File

@@ -0,0 +1,285 @@
use crate::atom_table::*;
use ordered_float::OrderedFloat;
use dashu::*;
use std::collections::BTreeMap;
use std::collections::HashMap;
pub type QueryResult = Result<QueryResolution, String>;
#[derive(Debug, Clone, PartialEq, Eq)]
pub enum QueryResolution {
True,
False,
Matches(Vec<QueryMatch>),
}
#[derive(Debug, Clone, PartialEq, Eq)]
pub struct QueryMatch {
pub bindings: BTreeMap<String, Value>,
}
#[derive(Debug, Clone, PartialEq, Eq)]
pub enum QueryResolutionLine {
True,
False,
Match(BTreeMap<String, Value>),
}
#[derive(Debug, Clone, PartialEq, Eq)]
pub enum Value {
Integer(Integer),
Rational(Rational),
Float(OrderedFloat<f64>),
Atom(Atom),
String(String),
List(Vec<Value>),
Structure(Atom, Vec<Value>),
Var,
}
impl From<BTreeMap<&str, Value>> for QueryMatch {
fn from(bindings: BTreeMap<&str, Value>) -> Self {
QueryMatch {
bindings: bindings
.into_iter()
.map(|(k, v)| (k.to_string(), v))
.collect::<BTreeMap<_, _>>(),
}
}
}
impl From<BTreeMap<String, Value>> for QueryMatch {
fn from(bindings: BTreeMap<String, Value>) -> Self {
QueryMatch { bindings }
}
}
impl From<Vec<QueryResolutionLine>> for QueryResolution {
fn from(query_result_lines: Vec<QueryResolutionLine>) -> Self {
// If there is only one line, and it is true or false, return that.
if query_result_lines.len() == 1 {
match query_result_lines[0].clone() {
QueryResolutionLine::True => return QueryResolution::True,
QueryResolutionLine::False => return QueryResolution::False,
_ => {}
}
}
// If there is only one line, and it is an empty match, return true.
if query_result_lines.len() == 1 {
match query_result_lines[0].clone() {
QueryResolutionLine::Match(m) => {
if m.is_empty() {
return QueryResolution::True;
}
}
_ => {}
}
}
// If there is at least one line with true and no matches, return true.
if query_result_lines
.iter()
.any(|l| l == &QueryResolutionLine::True)
&& !query_result_lines.iter().any(|l| {
if let &QueryResolutionLine::Match(_) = l {
true
} else {
false
}
})
{
return QueryResolution::True;
}
// If there is at least one match, return all matches.
let all_matches = query_result_lines
.into_iter()
.filter(|l| {
if let &QueryResolutionLine::Match(_) = l {
true
} else {
false
}
})
.map(|l| match l {
QueryResolutionLine::Match(m) => QueryMatch::from(m),
_ => unreachable!(),
})
.collect::<Vec<_>>();
if !all_matches.is_empty() {
return QueryResolution::Matches(all_matches);
}
QueryResolution::False
}
}
fn split_response_string(input: &str) -> Vec<String> {
let mut level_bracket = 0;
let mut level_parenthesis = 0;
let mut in_double_quotes = false;
let mut in_single_quotes = false;
let mut start = 0;
let mut result = Vec::new();
for (i, c) in input.chars().enumerate() {
match c {
'[' => level_bracket += 1,
']' => level_bracket -= 1,
'(' => level_parenthesis += 1,
')' => level_parenthesis -= 1,
'"' => in_double_quotes = !in_double_quotes,
'\'' => in_single_quotes = !in_single_quotes,
',' if level_bracket == 0 && level_parenthesis == 0 && !in_double_quotes && !in_single_quotes => {
result.push(input[start..i].trim().to_string());
start = i + 1;
}
_ => {}
}
}
result.push(input[start..].trim().to_string());
result
}
fn split_key_value_pairs(input: &str) -> Vec<(String, String)> {
let items = split_response_string(input);
let mut result = Vec::new();
for item in items {
let parts: Vec<&str> = item.splitn(2, '=').collect();
if parts.len() == 2 {
let key = parts[0].trim().to_string();
let value = parts[1].trim().to_string();
result.push((key, value));
}
}
result
}
fn parse_prolog_response(input: &str) -> HashMap<String, String> {
let mut map: HashMap<String, String> = HashMap::new();
// Use regex to match strings including commas inside them
for result in split_key_value_pairs(input) {
let key = result.0;
let value = result.1;
// cut off at given characters/strings:
let value = value.split("\n").next().unwrap().to_string();
let value = value.split(" ").next().unwrap().to_string();
let value = value.split("\t").next().unwrap().to_string();
let value = value.split("error").next().unwrap().to_string();
map.insert(key, value);
}
map
}
impl TryFrom<String> for QueryResolutionLine {
type Error = ();
fn try_from(string: String) -> Result<Self, Self::Error> {
match string.as_str() {
"true" => Ok(QueryResolutionLine::True),
"false" => Ok(QueryResolutionLine::False),
_ => Ok(QueryResolutionLine::Match(
parse_prolog_response(&string)
.iter()
.map(|(k, v)| -> Result<(String, Value), ()> {
let key = k.to_string();
let value = v.to_string();
Ok((key, Value::try_from(value)?))
})
.filter_map(Result::ok)
.collect::<BTreeMap<_, _>>()
)
),
}
}
}
fn split_nested_list(input: &str) -> Vec<String> {
let mut level = 0;
let mut start = 0;
let mut result = Vec::new();
for (i, c) in input.chars().enumerate() {
match c {
'[' => level += 1,
']' => level -= 1,
',' if level == 0 => {
result.push(input[start..i].trim().to_string());
start = i + 1;
}
_ => {}
}
}
result.push(input[start..].trim().to_string());
result
}
impl TryFrom<String> for Value {
type Error = ();
fn try_from(string: String) -> Result<Self, Self::Error> {
let trimmed = string.trim();
if let Ok(float_value) = string.parse::<f64>() {
Ok(Value::Float(OrderedFloat(float_value)))
} else if let Ok(int_value) = string.parse::<i128>() {
Ok(Value::Integer(int_value.into()))
} else if trimmed.starts_with("'") && trimmed.ends_with("'") {
Ok(Value::String(trimmed[1..trimmed.len() - 1].into()))
} else if trimmed.starts_with("\"") && trimmed.ends_with("\"") {
Ok(Value::String(trimmed[1..trimmed.len() - 1].into()))
} else if trimmed.starts_with("[") && trimmed.ends_with("]") {
let split = split_nested_list(&trimmed[1..trimmed.len() - 1]);
let values = split
.into_iter()
.map(Value::try_from)
.collect::<Result<Vec<_>, _>>()?;
Ok(Value::List(values))
} else if trimmed.starts_with("{") && trimmed.ends_with("}") {
let mut iter = trimmed[1..trimmed.len() - 1].split(",");
let mut values = vec![];
while let Some(value) = iter.next() {
let items: Vec<_> = value.split(":").collect();
if items.len() == 2 {
let _key = items[0].to_string();
let value = items[1].to_string();
values.push(Value::try_from(value)?);
}
}
Ok(Value::Structure(atom!("{}"), values))
} else if trimmed.starts_with("<<") && trimmed.ends_with(">>") {
let mut iter = trimmed[2..trimmed.len() - 2].split(",");
let mut values = vec![];
while let Some(value) = iter.next() {
let items: Vec<_> = value.split(":").collect();
if items.len() == 2 {
let _key = items[0].to_string();
let value = items[1].to_string();
values.push(Value::try_from(value)?);
}
}
Ok(Value::Structure(atom!("<<>>"), values))
} else if !trimmed.contains(",") && !trimmed.contains("'") && !trimmed.contains("\"") {
Ok(Value::String(trimmed.into()))
} else {
Err(())
}
}
}
impl From<&str> for Value {
fn from(str: &str) -> Self {
Value::String(str.to_string())
}
}

View File

@@ -43,11 +43,10 @@ impl Into<Atom> for PartialString {
impl PartialString {
#[inline]
pub(super) fn new<'a>(src: &'a str, atom_tbl: &mut AtomTable) -> Option<(Self, &'a str)> {
pub(super) fn new<'a>(src: &'a str, atom_tbl: &AtomTable) -> Option<(Self, &'a str)> {
let terminator_idx = scan_for_terminator(src.chars());
let pstr = PartialString(atom_tbl.build_with(&src[.. terminator_idx]));
Some(if terminator_idx < src.as_bytes().len() {
let pstr = PartialString(AtomTable::build_with(&atom_tbl, &src[..terminator_idx]));
Some(if terminator_idx < src.as_bytes().len() {
(pstr, &src[terminator_idx + 1..])
} else {
(pstr, "")
@@ -55,8 +54,8 @@ impl PartialString {
}
#[inline(always)]
pub(crate) fn as_str_from(&self, n: usize) -> &str {
&self.0.as_str()[n..]
pub(crate) fn as_str_from(&self, n: usize) -> AtomString {
self.0.as_str().map(|str| &str[n..])
}
}
@@ -124,11 +123,15 @@ impl<'a> HeapPStrIter<'a> {
let mut final_result = None;
while let Some(PStrIterStep { iteratee, next_hare }) = self.step(self.brent_st.hare) {
while let Some(PStrIterStep {
iteratee,
next_hare,
}) = self.step(self.brent_st.hare)
{
self.brent_st.hare = next_hare;
self.focus = self.heap[iteratee.focus()];
result.focus = iteratee.focus();
result.focus = iteratee.focus();
result.offset = iteratee.offset();
match iteratee {
@@ -151,7 +154,7 @@ impl<'a> HeapPStrIter<'a> {
let s = &s[result.prefix_len..];
if s.len() >= t.len() {
if s.starts_with(t) {
if (&*s).starts_with(&*t) {
result.prefix_len += t.len();
result.offset += t.len();
} else {
@@ -181,7 +184,7 @@ impl<'a> HeapPStrIter<'a> {
self.brent_st.hare = result.focus;
} else {
read_heap_cell!(self.heap[result.focus],
(HeapCellValueTag::Lis | HeapCellValueTag::Str) => {
(HeapCellValueTag::Lis | HeapCellValueTag::Str | HeapCellValueTag::PStr) => {
self.focus = self.heap[self.brent_st.hare];
}
_ => {
@@ -202,7 +205,7 @@ impl<'a> HeapPStrIter<'a> {
self.brent_st.hare = self.orig_focus;
self.brent_st.tortoise = self.orig_focus;
for _ in 0 .. self.brent_st.lam {
for _ in 0..self.brent_st.lam {
self.brent_st.hare = self.step(self.brent_st.hare).unwrap().next_hare;
}
@@ -225,7 +228,7 @@ impl<'a> HeapPStrIter<'a> {
}
PStrIteratee::PStrSegment(_, pstr_atom, n) => {
let pstr = PartialString::from(pstr_atom);
buf += pstr.as_str_from(n);
buf += &*pstr.as_str_from(n);
}
}
}
@@ -238,43 +241,43 @@ impl<'a> HeapPStrIter<'a> {
let mut focus = self.focus;
loop {
read_heap_cell!(focus,
(HeapCellValueTag::CStr | HeapCellValueTag::PStrLoc) => {
return true;
}
(HeapCellValueTag::Atom, (name, arity)) => { // TODO: use Str here?
return name == atom!(".") && arity == 2;
}
(HeapCellValueTag::Lis, h) => {
let value = self.heap[h];
let value = heap_bound_store(
self.heap,
heap_bound_deref(self.heap, value),
);
read_heap_cell!(focus,
(HeapCellValueTag::CStr | HeapCellValueTag::PStrLoc) => {
return true;
}
(HeapCellValueTag::Atom, (name, arity)) => { // TODO: use Str here?
return name == atom!(".") && arity == 2;
}
(HeapCellValueTag::Lis, h) => {
let value = self.heap[h];
let value = heap_bound_store(
self.heap,
heap_bound_deref(self.heap, value),
);
return read_heap_cell!(value,
(HeapCellValueTag::Atom, (name, arity)) => {
arity == 0 && name.as_char().is_some()
}
(HeapCellValueTag::Char) => {
true
}
_ => {
false
}
);
}
(HeapCellValueTag::AttrVar | HeapCellValueTag::Var, h) => {
if focus == self.heap[h] {
return false;
}
return read_heap_cell!(value,
(HeapCellValueTag::Atom, (name, arity)) => {
arity == 0 && name.as_char().is_some()
}
(HeapCellValueTag::Char) => {
true
}
_ => {
false
}
);
}
(HeapCellValueTag::AttrVar | HeapCellValueTag::Var, h) => {
if focus == self.heap[h] {
return false;
}
focus = self.heap[h];
}
_ => {
return false;
}
);
focus = self.heap[h];
}
_ => {
return false;
}
);
}
}
@@ -381,13 +384,15 @@ impl<'a> HeapPStrIter<'a> {
}
fn pre_cycle_discovery_stepper(&mut self) -> Option<PStrIteratee> {
let PStrIterStep { iteratee, next_hare } =
match self.step(self.brent_st.hare) {
Some(results) => results,
None => {
return None;
}
};
let PStrIterStep {
iteratee,
next_hare,
} = match self.step(self.brent_st.hare) {
Some(results) => results,
None => {
return None;
}
};
self.focus = self.heap[iteratee.focus()];
@@ -421,13 +426,15 @@ impl<'a> HeapPStrIter<'a> {
return None;
}
let PStrIterStep { iteratee, next_hare } =
match self.step(self.brent_st.hare) {
Some(results) => results,
None => {
return None;
}
};
let PStrIterStep {
iteratee,
next_hare,
} = match self.step(self.brent_st.hare) {
Some(results) => results,
None => {
return None;
}
};
self.focus = self.heap[next_hare];
self.brent_st.hare = next_hare;
@@ -515,11 +522,8 @@ impl<'a> Iterator for PStrCharsIter<'a> {
match pstr.as_str_from(n).chars().next() {
Some(c) => {
self.item = Some(PStrIteratee::PStrSegment(
f1,
pstr_atom,
n + c.len_utf8(),
));
self.item =
Some(PStrIteratee::PStrSegment(f1, pstr_atom, n + c.len_utf8()));
return Some(c);
}
@@ -684,8 +688,10 @@ pub fn compare_pstr_prefixes<'a>(
}
}
}
(PStrIteratee::PStrSegment(f1, pstr1_atom, n1),
PStrIteratee::PStrSegment(f2, pstr2_atom, n2)) => {
(
PStrIteratee::PStrSegment(f1, pstr1_atom, n1),
PStrIteratee::PStrSegment(f2, pstr2_atom, n2),
) => {
if pstr1_atom == pstr2_atom && n1 == n2 {
cycle_detection_step(i1, i2, &step_1);
let both_cyclic = cycle_detection_step(i2, i1, &step_2);
@@ -707,7 +713,7 @@ pub fn compare_pstr_prefixes<'a>(
let str2 = pstr2.as_str_from(n2);
match str1.len().cmp(&str2.len()) {
Ordering::Equal if str1 == str2 => {
Ordering::Equal if &*str1 == &*str2 => {
cycle_detection_step(i1, i2, &step_1);
let both_cyclic = cycle_detection_step(i2, i1, &step_2);
@@ -718,8 +724,9 @@ pub fn compare_pstr_prefixes<'a>(
continue;
}
}
Ordering::Less if str2.starts_with(str1) => {
step_2.iteratee = PStrIteratee::PStrSegment(f2, pstr2_atom, n2 + str1.len());
Ordering::Less if str2.starts_with(&*str1) => {
step_2.iteratee =
PStrIteratee::PStrSegment(f2, pstr2_atom, n2 + str1.len());
let c1_result = cycle_detection_step(i1, i2, &step_1);
r1 = step(i1, i1.brent_st.hare);
@@ -727,8 +734,9 @@ pub fn compare_pstr_prefixes<'a>(
continue;
}
}
Ordering::Greater if str1.starts_with(str2) => {
step_1.iteratee = PStrIteratee::PStrSegment(f1, pstr1_atom, n1 + str2.len());
Ordering::Greater if str1.starts_with(&*str2) => {
step_1.iteratee =
PStrIteratee::PStrSegment(f1, pstr1_atom, n1 + str2.len());
let c2_result = cycle_detection_step(i2, i1, &step_2);
r2 = step(i2, i2.brent_st.hare);
@@ -737,7 +745,7 @@ pub fn compare_pstr_prefixes<'a>(
}
}
_ => {
return PStrCmpResult::Ordered(str1.cmp(str2));
return PStrCmpResult::Ordered(str1.cmp(&*str2));
}
}
}
@@ -796,11 +804,8 @@ mod test {
fn pstr_iter_tests() {
let mut wam = MockWAM::new();
let pstr_var_cell = put_partial_string(
&mut wam.machine_st.heap,
"abc ",
&mut wam.machine_st.atom_tbl,
);
let pstr_var_cell =
put_partial_string(&mut wam.machine_st.heap, "abc ", &wam.machine_st.atom_tbl);
let pstr_cell = wam.machine_st.heap[pstr_var_cell.get_value() as usize];
@@ -819,11 +824,8 @@ mod test {
wam.machine_st.heap.pop();
wam.machine_st.heap.push(pstr_loc_as_cell!(2));
let pstr_second_var_cell = put_partial_string(
&mut wam.machine_st.heap,
"def",
&mut wam.machine_st.atom_tbl,
);
let pstr_second_var_cell =
put_partial_string(&mut wam.machine_st.heap, "def", &wam.machine_st.atom_tbl);
let pstr_second_cell = wam.machine_st.heap[pstr_second_var_cell.get_value() as usize];
@@ -836,7 +838,11 @@ mod test {
);
assert_eq!(
iter.next(),
Some(PStrIteratee::PStrSegment(2, cell_as_atom!(pstr_second_cell), 0))
Some(PStrIteratee::PStrSegment(
2,
cell_as_atom!(pstr_second_cell),
0
))
);
assert_eq!(iter.next(), None);
@@ -855,7 +861,11 @@ mod test {
);
assert_eq!(
iter.next(),
Some(PStrIteratee::PStrSegment(2, cell_as_atom!(pstr_second_cell), 0))
Some(PStrIteratee::PStrSegment(
2,
cell_as_atom!(pstr_second_cell),
0
))
);
assert_eq!(iter.next(), None);
@@ -863,10 +873,14 @@ mod test {
}
wam.machine_st.heap.pop();
wam.machine_st.heap.push(pstr_loc_as_cell!(wam.machine_st.heap.len() + 1));
wam.machine_st
.heap
.push(pstr_loc_as_cell!(wam.machine_st.heap.len() + 1));
wam.machine_st.heap.push(pstr_offset_as_cell!(0));
wam.machine_st.heap.push(fixnum_as_cell!(Fixnum::build_with(0)));
wam.machine_st
.heap
.push(fixnum_as_cell!(Fixnum::build_with(0)));
{
let mut iter = HeapPStrIter::new(&wam.machine_st.heap, 0);
@@ -892,31 +906,25 @@ mod test {
// construct a structurally similar but different cyclic partial string
// matching the one beginning at wam.machine_st.heap[0].
put_partial_string(
&mut wam.machine_st.heap,
"ab",
&mut wam.machine_st.atom_tbl,
);
put_partial_string(&mut wam.machine_st.heap, "ab", &wam.machine_st.atom_tbl);
wam.machine_st.heap.pop();
wam.machine_st.heap.push(pstr_loc_as_cell!(second_h+2));
wam.machine_st.heap.push(pstr_loc_as_cell!(second_h + 2));
put_partial_string(
&mut wam.machine_st.heap,
"c ",
&mut wam.machine_st.atom_tbl,
);
put_partial_string(&mut wam.machine_st.heap, "c ", &wam.machine_st.atom_tbl);
wam.machine_st.heap.pop();
wam.machine_st.heap.push(pstr_loc_as_cell!(second_h+4));
wam.machine_st.heap.push(pstr_loc_as_cell!(second_h + 4));
wam.machine_st.heap.push(pstr_second_cell);
wam.machine_st.heap.push(pstr_loc_as_cell!(second_h+6));
wam.machine_st.heap.push(pstr_loc_as_cell!(second_h + 6));
wam.machine_st.heap.push(pstr_offset_as_cell!(second_h));
wam.machine_st.heap.push(fixnum_as_cell!(Fixnum::build_with(0)));
wam.machine_st
.heap
.push(fixnum_as_cell!(Fixnum::build_with(0)));
let mut iter1 = HeapPStrIter::new(&wam.machine_st.heap, 0);
let mut iter2 = HeapPStrIter::new(&wam.machine_st.heap, second_h);
@@ -929,11 +937,7 @@ mod test {
wam.machine_st.heap.clear();
put_partial_string(
&mut wam.machine_st.heap,
"abc ",
&mut wam.machine_st.atom_tbl,
);
put_partial_string(&mut wam.machine_st.heap, "abc ", &wam.machine_st.atom_tbl);
let pstr_cell = wam.machine_st.heap[0];
@@ -963,11 +967,8 @@ mod test {
wam.machine_st.heap.clear();
let cstr_var_cell = put_complete_string(
&mut wam.machine_st.heap,
"abc",
&mut wam.machine_st.atom_tbl,
);
let cstr_var_cell =
put_complete_string(&mut wam.machine_st.heap, "abc", &wam.machine_st.atom_tbl);
wam.machine_st.heap.push(list_loc_as_cell!(2));
wam.machine_st.heap.push(heap_loc_as_cell!(2));
@@ -982,30 +983,18 @@ mod test {
unify!(wam.machine_st, cstr_var_cell, heap_loc_as_cell!(1));
assert_eq!(
wam.machine_st.heap[2],
char_as_cell!('a'),
);
assert_eq!(wam.machine_st.heap[2], char_as_cell!('a'),);
assert_eq!(
wam.machine_st.heap[4],
char_as_cell!('b'),
);
assert_eq!(wam.machine_st.heap[4], char_as_cell!('b'),);
assert_eq!(
wam.machine_st.heap[6],
char_as_cell!('c'),
);
assert_eq!(wam.machine_st.heap[6], char_as_cell!('c'),);
// test "abc" = [X,Y,Z|D].
wam.machine_st.heap.clear();
let cstr_var_cell = put_complete_string(
&mut wam.machine_st.heap,
"abc",
&mut wam.machine_st.atom_tbl,
);
let cstr_var_cell =
put_complete_string(&mut wam.machine_st.heap, "abc", &wam.machine_st.atom_tbl);
wam.machine_st.heap.push(list_loc_as_cell!(2));
wam.machine_st.heap.push(heap_loc_as_cell!(2)); // X
@@ -1022,35 +1011,20 @@ mod test {
assert_eq!(wam.machine_st.fail, false);
assert_eq!(
wam.machine_st.heap[2],
char_as_cell!('a'),
);
assert_eq!(wam.machine_st.heap[2], char_as_cell!('a'),);
assert_eq!(
wam.machine_st.heap[4],
char_as_cell!('b'),
);
assert_eq!(wam.machine_st.heap[4], char_as_cell!('b'),);
assert_eq!(
wam.machine_st.heap[6],
char_as_cell!('c'),
);
assert_eq!(wam.machine_st.heap[6], char_as_cell!('c'),);
assert_eq!(
wam.machine_st.heap[7],
empty_list_as_cell!(),
);
assert_eq!(wam.machine_st.heap[7], empty_list_as_cell!(),);
// test "d" = [d].
wam.machine_st.heap.clear();
let cstr_var_cell = put_complete_string(
&mut wam.machine_st.heap,
"d",
&mut wam.machine_st.atom_tbl,
);
let cstr_var_cell =
put_complete_string(&mut wam.machine_st.heap, "d", &wam.machine_st.atom_tbl);
wam.machine_st.heap.push(list_loc_as_cell!(2));
wam.machine_st.heap.push(char_as_cell!('d'));
@@ -1064,11 +1038,8 @@ mod test {
wam.machine_st.heap.clear();
let cstr_var_cell = put_complete_string(
&mut wam.machine_st.heap,
"abc",
&mut wam.machine_st.atom_tbl,
);
let cstr_var_cell =
put_complete_string(&mut wam.machine_st.heap, "abc", &wam.machine_st.atom_tbl);
wam.machine_st.heap.push(list_loc_as_cell!(2));
wam.machine_st.heap.push(heap_loc_as_cell!(2));
@@ -1085,30 +1056,17 @@ mod test {
assert_eq!(wam.machine_st.fail, false);
assert_eq!(
wam.machine_st.heap[2],
char_as_cell!('a'),
);
assert_eq!(wam.machine_st.heap[2], char_as_cell!('a'),);
assert_eq!(
wam.machine_st.heap[4],
char_as_cell!('b'),
);
assert_eq!(wam.machine_st.heap[4], char_as_cell!('b'),);
assert_eq!(
wam.machine_st.heap[6],
char_as_cell!('c'),
);
assert_eq!(wam.machine_st.heap[6], char_as_cell!('c'),);
// test "abcdef" = [a,b,c|X].
wam.machine_st.heap.clear();
put_complete_string(
&mut wam.machine_st.heap,
"abcdef",
&mut wam.machine_st.atom_tbl,
);
put_complete_string(&mut wam.machine_st.heap, "abcdef", &wam.machine_st.atom_tbl);
wam.machine_st.heap.push(pstr_as_cell!(atom!("abc")));
wam.machine_st.heap.push(heap_loc_as_cell!(2));
@@ -1123,7 +1081,10 @@ mod test {
assert_eq!(wam.machine_st.heap[3], pstr_loc_as_cell!(1));
assert_eq!(wam.machine_st.heap[4], atom_as_cstr_cell!(atom!("abcdef")));
assert_eq!(wam.machine_st.heap[5], pstr_offset_as_cell!(4));
assert_eq!(wam.machine_st.heap[6], fixnum_as_cell!(Fixnum::build_with("abc".len() as i64)));
assert_eq!(
wam.machine_st.heap[6],
fixnum_as_cell!(Fixnum::build_with("abc".len() as i64))
);
// test iteration on X = [b,c,b,c,b,c,b,c|...] as an offset.
@@ -1132,7 +1093,9 @@ mod test {
wam.machine_st.heap.push(pstr_as_cell!(atom!("abc")));
wam.machine_st.heap.push(pstr_loc_as_cell!(2));
wam.machine_st.heap.push(pstr_offset_as_cell!(0));
wam.machine_st.heap.push(fixnum_as_cell!(Fixnum::build_with(1)));
wam.machine_st
.heap
.push(fixnum_as_cell!(Fixnum::build_with(1)));
{
let mut iter = HeapPStrIter::new(&wam.machine_st.heap, 2);

Some files were not shown because too many files have changed in this diff Show More