diff --git a/README.md b/README.md index 1f33fba..4c565f2 100644 --- a/README.md +++ b/README.md @@ -18,10 +18,19 @@ same Id. ## Use +Keep the directive that names the terms to intern in a file of its own: + ```prolog -:- module(steps, [step/2, built/2]). +% calculus_templates.pl :- use_module(library(hash_consing), []). :- hash_consing:rewritten([apply(lambda(_), _), lambda(_), variable(_)]). +``` + +and include it in every file that uses these terms: + +```prolog +:- module(steps, [step/2, built/2]). +:- include(calculus_templates). step(apply(lambda(Body), Argument), beta(Body, Argument)). @@ -29,9 +38,27 @@ built(Function, Applied) :- Applied = apply(Function, variable(0)). ``` +```prolog +:- module(redexes, [is_redex/1]). +:- include(calculus_templates). + +is_redex(apply(lambda(_), _)). +``` + Here an application is interned when its first argument is a lambda; any other application stays a plain compound whose arguments are represented in -turn. A term that did not come through the rewrite crosses the boundary with +turn. The included directive opts in the file that includes it, so both +modules rewrite the same terms: when `built/2` in `steps` applies a lambda, +the application it makes is the Id that the head of `is_redex/1` in +`redexes` expects. + +**Warning:** the rewrite is per file. A file rewrites only the terms its own +directive names, and the library checks nothing between files. A file that +receives interned terms without including the directive keeps plain terms +in its clauses, so its heads never unify with the Ids: the call fails, +silently, with no error. Write the directive once and include it everywhere. + +A term that did not come through the rewrite crosses the boundary with `hash_consing:internalized/3`, `hash_consing:externalized/2` turns Ids back into terms, and `hash_consing:declared/1` declares templates at run time, for constructors a program makes as it runs. The module comment of @@ -49,10 +76,18 @@ template's constructor, whose arguments match the nested template's). A constructor may have several templates. They are tried in the order of the list, the first that matches a term is its template, and a term that none matches is not interned. From -[`test/hash_consing_fixtures/patterns.pl`](test/hash_consing_fixtures/patterns.pl): +[`test/hash_consing_fixtures/patterns_templates.pl`](test/hash_consing_fixtures/patterns_templates.pl): ```prolog +:- use_module(library(hash_consing), []). :- hash_consing:rewritten([app(abs(_), _), app(app(*, _), _), app(_, ref(_)), abs(_), ref(_)]). +``` + +and [`test/hash_consing_fixtures/patterns.pl`](test/hash_consing_fixtures/patterns.pl), +which includes it: + +```prolog +:- include(patterns_templates). % Must intern, every instance taking the first template: the shape `abs/1` % is written into the head. diff --git a/pack.pl b/pack.pl index 6962cb1..89211c0 100644 --- a/pack.pl +++ b/pack.pl @@ -1,5 +1,5 @@ name(hash_consing). -version('0.2.0'). +version('0.2.1'). title('Hash-consed terms by clause rewriting'). keywords([interning, 'hash-consing', trie, term_expansion]). author('Yang, Bo', 'yang-bo@yang-bo.com'). diff --git a/prolog/hash_consing.pl b/prolog/hash_consing.pl index 1eb5cd1..67cbe1f 100644 --- a/prolog/hash_consing.pl +++ b/prolog/hash_consing.pl @@ -191,8 +191,10 @@ intern and needs no mode declaration. Several directives in one file add up, each declaring whole lists. An empty list rewrites nothing. The library checks no consistency between files: files that pass one constructor to each -other must both list it, which the user arranges, for instance with one -included file (user ruling, 2026-09-17). +other must both list it, which the user arranges (user ruling, 2026-09-17). +SHARE ONE DIRECTIVE BY `include/1`: keep the directive in one file that every +file handing these terms to another includes; an included directive opts in +the file that includes it. A file left out fails silently (the FIXME below). AN OCCURRENCE IS CLASSIFIED while the file loads, by comparing its source pattern with each template of its constructor: every instance of the pattern @@ -261,10 +263,12 @@ and a callee could not otherwise tell whether to receive an Id or a plain term. (2) Reflection sees Ids: `=..`, `functor/3`, `arg/3`, `write/1`, `variant_sha1/2`, `term_hash/2` and ordering whose result depends on the -order see `'__hash_consed_Name/Arity'(Handle)`. Code that reads structure calls -`externalized/2` first, and code that builds an instance with them calls -`internalized/3` after; an instance that must be interned and is left -uninterned fails to unify at every rewritten position. Using an Id as an +order see `'__hash_consed_Name/Arity'(Handle)`; the standard order of two Ids +depends on the history of insertions into the store, not on their terms. +Code that reads structure calls `externalized/2` first, and code that builds +an instance with them calls `internalized/3` after; an instance that must +be interned and is left uninterned fails to unify at every rewritten +position. Using an Id as an opaque key, whose result does not depend on the order (an assoc key, a sort to remove duplicates), is fine. @@ -289,27 +293,15 @@ such a value. Candidate fix: none in the trie API; the assertz backends of the benchmark raise instead, at the costs recorded there. -FIXME: on 2026-09-14, within tabled -compiles near a full stack, `trie_lookup/3` failed silently on a key of the -store and left the resource error pending. Here such a failure turns an -upsert into an insertion of an existing key, which raises, or a lookup into a -failure, which reads as no answer rather than `resource_error`. A direct probe -at 1m, 4m and 32m stacks on 2026-09-17 raised `resource_error(stack)` every -time and did not reproduce it. - -FIXME: the order of two Ids depends on the insertion -history. Nothing checks that no code in an opted-in file reads that order; -it is a rule of the file, stated above. - FIXME: an Id written into a clause while the file loads is a handle of this process. A file must be loaded from source, never -`qcompile`d nor saved in a state, and the store lives in one thread's global -variable. +`qcompile`d nor saved in a state, and a thread reads such an Id only after it +installs the loading thread's store (THREADS SHARE THE STORE, above). FIXME: a file that uses a constructor another file interns, without listing it, passes its instances uninterned; the rewritten -positions of the other file then fail to unify, silently. The library cannot -see it. +positions of the other file then fail to unify, silently. The library does +not check it; one directive shared by `include/1` (above) avoids it. */ :- use_module(library(error), [must_be/2]). @@ -317,8 +309,10 @@ :- initialization(stores_created). -%! stores_created the store and the spellings of the shapes, two tries in -% global variables of the loading thread. +%! stores_created +% +% The store and the spellings of the shapes, two tries in global variables +% of the loading thread. stores_created :- trie_new(Store), @@ -328,7 +322,9 @@ % ---- the relation ---- -%! intern(?Term, ?Id) Id is the Id of the ground term Term. +%! intern(?Term, ?Id) +% +% Id is the Id of the ground term Term. intern(Term, Id) :- nonvar(Id), @@ -342,9 +338,10 @@ intern(Term, Id) :- upserted(Term, Id). -%! upserted(+Term, ?Id) when a template of Term's constructor matches it, -% insert Term unless it is stored, and answer its Id; fail, inserting -% nothing, when none does. +%! upserted(+Term, ?Id) +% +% When a template of Term's constructor matches it, insert Term unless it is +% stored, and answer its Id; fail, inserting nothing, when none does. upserted(Term, Id) :- ( ground(Term) @@ -404,9 +401,11 @@ trie_update(Trie, Term, Handle). settled_handle(_, _, Handle, Handle). -%! represented(?Layer, ?Representation) Representation represents Layer, a -% constructor applied to represented arguments: its Id when a template of -% the constructor matches it, Layer itself otherwise. +%! represented(?Layer, ?Representation) +% +% Representation represents Layer, a constructor applied to represented +% arguments: its Id when a template of the constructor matches it, Layer +% itself otherwise. % % Given an Id of the constructor, Layer is its stored term, or, when the % handle is unbound, Layer is interned into it and must be ground. Given @@ -455,10 +454,11 @@ ; throw(error(instantiation_error, context(hash_consing:represented/2, Layer))) ). -%! represented_settled(+Layer, ?Representation) represented/2 at the end of -% a rewritten head, where rule (1) of the module comment leaves no Id -% pattern with an unbound handle: such a pattern raises an instantiation -% error. +%! represented_settled(+Layer, ?Representation) +% +% Represented/2 at the end of a rewritten head, where rule (1) of the module +% comment leaves no Id pattern with an unbound handle: such a pattern raises +% an instantiation error. represented_settled(Layer, Representation) :- represented(Layer, Representation), @@ -468,19 +468,22 @@ ; true ). -%! is_id(+Value) Value is an Id: an Id functor this process made, applied -% to a bound handle. +%! is_id(+Value) +% +% Value is an Id: an Id functor this process made, applied to a bound +% handle. is_id(Value) :- id_parts(Value, _, _, Handle), nonvar(Handle). -%! id_parts(+Value, -IdName, -Shape, -Handle) Value is an Id or an Id -% pattern: its functor is one id_name/3 made, which the first argument -% index of id_constructor/3 finds without scanning the name (the prefix -% test it replaces took 30 percent of a lambda_jit read, 2026-09-26). -% Shape is `none` for a constructor without a shape. Fails on any other -% value. +%! id_parts(+Value, -IdName, -Shape, -Handle) +% +% Value is an Id or an Id pattern: its functor is one id_name/3 made, which +% the first argument index of id_constructor/3 finds without scanning the +% name (the prefix test it replaces took 30 percent of a lambda_jit read, +% 2026-09-26). Shape is `none` for a constructor without a shape. Fails on +% any other value. id_parts(Value, IdName, Shape, Handle) :- compound(Value), @@ -494,10 +497,11 @@ arg(1, Value, Shape), arg(2, Value, Handle). -%! id_built(+Name, +Arity, +Kind, +Structure, ?Handle, -Id) the Id, or -% the Id pattern, of the constructor with the handle Handle: no shape when -% Kind is `root_only`, an unbound shape when Structure is `unknown`, and -% otherwise the spelling of Structure. +%! id_built(+Name, +Arity, +Kind, +Structure, ?Handle, -Id) +% +% The Id, or the Id pattern, of the constructor with the handle Handle: no +% shape when Kind is `root_only`, an unbound shape when Structure is +% `unknown`, and otherwise the spelling of Structure. id_built(Name, Arity, Kind, Structure, Handle, Id) :- id_name(Name, Arity, IdName), @@ -509,8 +513,10 @@ compound_name_arguments(Id, IdName, [Shape, Handle]) ). -%! id_name(+Name, +Arity, -IdName) the functor name of the Ids of the -% constructor Name/Arity, remembered once made, in both directions. +%! id_name(+Name, +Arity, -IdName) +% +% The functor name of the Ids of the constructor Name/Arity, remembered once +% made, in both directions. :- dynamic known_id_name/3. % known_id_name(Name, Arity, IdName) :- dynamic id_constructor/3. % id_constructor(IdName, Name, Arity) @@ -543,15 +549,18 @@ :- dynamic constructor_templates/4. % constructor_templates(Name, Arity, Templates, Kind) -%! declared(+Templates) the constructors of the list declared for this -% process, each with its templates in the order of the list. +%! declared(+Templates) +% +% The constructors of the list declared for this process, each with its +% templates in the order of the list. declared(Templates) :- templates_declared(Templates, hash_consing:declared/1, _). -%! templates_known(+Name, +Arity, +Context, -Templates, -Kind) the declared -% templates of the constructor, and `root_only` or `shaped`; raises when -% the constructor has none. +%! templates_known(+Name, +Arity, +Context, -Templates, -Kind) +% +% The declared templates of the constructor, and `root_only` or `shaped`; +% raises when the constructor has none. templates_known(Name, Arity, Context, Templates, Kind) :- ( constructor_templates(Name, Arity, Templates, Kind) @@ -559,11 +568,13 @@ ; throw(error(existence_error(templates, Name/Arity), context(Context, _))) ). -%! templates_declared(+Templates, +Context, -Constructors) the list parsed -% and grouped by constructor, in the order of first appearance; every group -% checked before any is registered; Constructors the `Name/Arity` of the -% groups. Raises, registering nothing, on a malformed or unreachable -% template and on a constructor already declared with another list. +%! templates_declared(+Templates, +Context, -Constructors) +% +% The list parsed and grouped by constructor, in the order of first +% appearance; every group checked before any is registered; Constructors the +% `Name/Arity` of the groups. Raises, registering nothing, on a malformed or +% unreachable template and on a constructor already declared with another +% list. templates_declared(Templates, Context, Constructors) :- must_be(list, Templates), @@ -622,8 +633,9 @@ ), groups_checked(Groups, Context). -%! templates_reachable(+Written, +Templates, +Earlier, +Context) no -% template is always taken first by one template before it. +%! templates_reachable(+Written, +Templates, +Earlier, +Context) +% +% No template is always taken first by one template before it. templates_reachable([], [], _, _). templates_reachable([Template | Written], [Parsed | Templates], Earlier, Context) :- @@ -633,8 +645,9 @@ ; templates_reachable(Written, Templates, [Parsed | Earlier], Context) ). -%! template_covers(+Covering, +Covered) every term Covered matches, -% Covering matches too. +%! template_covers(+Covering, +Covered) +% +% Every term Covered matches, Covering matches too. template_covers(template(Constructor, Coverings), template(Constructor, Covereds)) :- arguments_cover(Coverings, Covereds). @@ -678,8 +691,9 @@ ; compound_name_arguments(Term, Name, Arguments) ). -%! templates_parsed(+Templates, +Context, -Pairs) each template paired with -% its parsed form, `Template-Parsed`. +%! templates_parsed(+Templates, +Context, -Pairs) +% +% Each template paired with its parsed form, `Template-Parsed`. templates_parsed([], _, []). templates_parsed([Template | Templates], Context, [Template-Parsed | Pairs]) :- @@ -713,8 +727,9 @@ argument_parsed(Argument, Context, Parsed) :- template_parsed(Argument, Context, Parsed). -%! templates_written(+Templates, -Written) parsed templates written back as -% a user writes them, for an error to show. +%! templates_written(+Templates, -Written) +% +% Parsed templates written back as a user writes them, for an error to show. templates_written([], []). templates_written([Template | Templates], [Written | Writtens]) :- @@ -753,9 +768,10 @@ % are and off an Id through the store, and a variable, or the arguments of % an Id pattern whose handle is unbound, are open. -%! value_classified(+Templates, +Value, -Class, -Structure) Class is -% `must_intern` when a template matches every term Value stands for, -% `must_not_intern` when no template matches any, `undetermined` +%! value_classified(+Templates, +Value, -Class, -Structure) +% +% Class is `must_intern` when a template matches every term Value stands +% for, `must_not_intern` when no template matches any, `undetermined` % otherwise. Structure is what the first template that matches some such % term records, when that template matches them all and every root it % records is known; `unknown` otherwise. @@ -801,8 +817,10 @@ descriptions_known(Inner) ). -%! first_template_recorded(+Templates, +Term, -Structure) what the first -% template that matches the ground Term records; fails when none does. +%! first_template_recorded(+Templates, +Term, -Structure) +% +% What the first template that matches the ground Term records; fails when +% none does. first_template_recorded([Template | Templates], Term, Structure) :- template_relation(Template, Term, Relation, Descriptions), @@ -811,10 +829,11 @@ ; first_template_recorded(Templates, Term, Structure) ). -%! template_relation(+Template, +Value, -Relation, -Descriptions) whether -% every term Value stands for matches the template (`instance`), none does -% (`disjoint`) or some do (`overlap`), and what the template records on -% them. Value's own root is the template's constructor. +%! template_relation(+Template, +Value, -Relation, -Descriptions) +% +% Whether every term Value stands for matches the template (`instance`), +% none does (`disjoint`) or some do (`overlap`), and what the template +% records on them. Value's own root is the template's constructor. template_relation(template(_, TemplateArguments), Value, Relation, Descriptions) :- compound_name_arguments_or_atom(Value, _, Arguments), @@ -864,9 +883,11 @@ root_description(other, other). root_description(Name/Arity, constructor(Name/Arity, none)). -%! value_root(+Value, -Root) the root constructor of the term Value stands -% for, `Name/Arity`, read off an Id's functor name without a lookup; -% `open` for a variable, `other` for a number or a string. +%! value_root(+Value, -Root) +% +% The root constructor of the term Value stands for, `Name/Arity`, read off +% an Id's functor name without a lookup; `open` for a variable, `other` for +% a number or a string. value_root(Value, open) :- var(Value), @@ -884,10 +905,11 @@ !. value_root(_, other). -%! value_view(+Value, -View) `layer(Name/Arity, Arguments)`, the root and -% the arguments of the term Value stands for, an Id's read from the store -% and open while its handle is unbound; `open` for a variable; `other` for -% a number or a string. +%! value_view(+Value, -View) +% +% `layer(Name/Arity, Arguments)`, the root and the arguments of the term +% Value stands for, an Id's read from the store and open while its handle is +% unbound; `open` for a variable; `other` for a number or a string. value_view(Value, open) :- var(Value), @@ -911,8 +933,10 @@ !. value_view(_, other). -%! structure_spelled(+Structure, -Atom) the shape atom of a structure, -% remembered in the trie of spellings so that it is built once. +%! structure_spelled(+Structure, -Atom) +% +% The shape atom of a structure, remembered in the trie of spellings so that +% it is built once. structure_spelled(Structure, Atom) :- nb_getval(hash_consing_spellings, Spellings), @@ -935,8 +959,10 @@ trie_insert(Spellings, Structure, Atom) ). -%! structure_atom(+Structure, -Atom) the spelling: descriptions joined by -% commas, `-` for `other`, `Name/Arity` and, in parentheses, what is below. +%! structure_atom(+Structure, -Atom) +% +% The spelling: descriptions joined by commas, `-` for `other`, `Name/Arity` +% and, in parentheses, what is below. structure_atom(Structure, Atom) :- descriptions_texts(Structure, Texts), @@ -957,8 +983,9 @@ % ---- the boundary ---- -%! externalized(+TermWithIds, -External) every Id replaced by its term, -% recursively. +%! externalized(+TermWithIds, -External) +% +% Every Id replaced by its term, recursively. externalized(Term, External) :- var(Term), @@ -985,10 +1012,11 @@ externalized(Argument, External), arguments_externalized(Arguments, Externals). -%! internalized(+Templates, +External, -TermWithIds) the templates declared -% as declared/1 declares them, then every instance of their constructors -% represented, bottom up: its Id when a template matches it, the plain -% term otherwise; an Id is kept as it is. +%! internalized(+Templates, +External, -TermWithIds) +% +% The templates declared as declared/1 declares them, then every instance of +% their constructors represented, bottom up: its Id when a template matches +% it, the plain term otherwise; an Id is kept as it is. internalized(Templates, External, TermWithIds) :- templates_declared(Templates, hash_consing:internalized/3, Constructors), @@ -1041,8 +1069,10 @@ % ---- the directive ---- -%! rewritten(+Templates) the file being loaded opts in for the -% constructors whose templates are in the list; several calls add up. +%! rewritten(+Templates) +% +% The file being loaded opts in for the constructors whose templates are in +% the list; several calls add up. :- dynamic registered_constructor/3. % registered_constructor(SourceFile, Name, Arity) @@ -1065,8 +1095,10 @@ % ---- the rewrite ---- -%! source_rewritten(+Source, -Rewritten) the rewrite of one term read from a -% file that opted in; fails, leaving the term to SWI-Prolog, otherwise. +%! source_rewritten(+Source, -Rewritten) +% +% The rewrite of one term read from a file that opted in; fails, leaving the +% term to SWI-Prolog, otherwise. source_rewritten(Source, _) :- var(Source), @@ -1101,8 +1133,9 @@ clause_rewritten(Head, File, Rewritten) :- rule_rewritten(Head, true, File, Rewritten). -%! rule_rewritten(+Head, +Body, +File, -Rewritten) the head's -% occurrences scheduled around the rewritten body. +%! rule_rewritten(+Head, +Body, +File, -Rewritten) +% +% The head's occurrences scheduled around the rewritten body. rule_rewritten(Qualifier:Head0, Body0, File, (Qualifier:Head :- Body)) :- !, @@ -1115,15 +1148,17 @@ body_rewritten(Body0, File, RewrittenBody), head_scheduled(Occurrences, RewrittenBody, Body). -%! arguments_of_abstracted(+Callable0, +File, -Callable, -Occurrences) the -% arguments of a head or a goal abstracted (its own functor is a predicate -% and is left alone), the ground occurrences represented now, and the -% others listed bottom up as `occurrence(Class, Layer, Representation, -% Handle)`: Class `id` for an occurrence that must be interned, its -% Representation an Id pattern and Handle that pattern's handle, and -% `undetermined(IdName)` for an undetermined one, its Representation and -% its Handle the fresh variable written where it stood. An occurrence that -% must not be interned is its layer, written in place, and is not listed. +%! arguments_of_abstracted(+Callable0, +File, -Callable, -Occurrences) +% +% The arguments of a head or a goal abstracted (its own functor is a +% predicate and is left alone), the ground occurrences represented now, and +% the others listed bottom up as +% `occurrence(Class, Layer, Representation, Handle)`: Class `id` for an +% occurrence that must be interned, its Representation an Id pattern and +% Handle that pattern's handle, and `undetermined(IdName)` for an +% undetermined one, its Representation and its Handle the fresh variable +% written where it stood. An occurrence that must not be interned is its +% layer, written in place, and is not listed. arguments_of_abstracted(Callable0, File, Callable, Occurrences) :- compound(Callable0), @@ -1140,9 +1175,11 @@ abstracted(Argument0, File, Argument, Reversed0, Reversed1), arguments_abstracted(Arguments0, File, Arguments, Reversed1, Reversed). -%! abstracted(+Term0, +File, -Term, +Reversed0, -Reversed) each occurrence -% of a listed constructor replaced by its representation in the clause, -% its subterms first, the listed occurrences prepended as they are met. +%! abstracted(+Term0, +File, -Term, +Reversed0, -Reversed) +% +% Each occurrence of a listed constructor replaced by its representation in +% the clause, its subterms first, the listed occurrences prepended as they +% are met. abstracted(Term, _, Term, Reversed, Reversed) :- var(Term), @@ -1161,10 +1198,10 @@ occurrence_abstracted(Term0, 0, Term0, Term0, File, Term, Reversed0, Reversed). abstracted(Term, _, Term, Reversed, Reversed). -%! occurrence_abstracted(+Name, +Arity, +Source, +Layer, +File, -% -Representation, +Reversed0, -Reversed) AN OCCURRENCE IS CLASSIFIED -% (above) by its source pattern Source, and written as an Id pattern, as -% its layer, or as a fresh variable. +%! occurrence_abstracted(+Name, +Arity, +Source, +Layer, +File, -Representation, +Reversed0, -Reversed) +% +% AN OCCURRENCE IS CLASSIFIED (above) by its source pattern Source, and +% written as an Id pattern, as its layer, or as a fresh variable. occurrence_abstracted(Name, Arity, Source, Layer, File, Representation, Reversed0, Reversed) :- ( registered_constructor(File, Name, Arity) @@ -1184,10 +1221,11 @@ Reversed, [occurrence(undetermined(IdName), Layer, Variable, Variable) | Reversed]) :- id_name(Name, Arity, IdName). -%! occurrences_baked(+BottomUp, -Remaining) an occurrence whose layer is -% ground is represented while the file loads, which binds its Id in the -% clause; bottom up, so a parent of baked occurrences may become ground in -% turn. +%! occurrences_baked(+BottomUp, -Remaining) +% +% An occurrence whose layer is ground is represented while the file loads, +% which binds its Id in the clause; bottom up, so a parent of baked +% occurrences may become ground in turn. occurrences_baked([], []). occurrences_baked([Occurrence | Occurrences], Remaining) :- @@ -1204,8 +1242,9 @@ occurrence_represented_now(undetermined(_), Layer, Variable) :- represented(Layer, Variable). -%! head_scheduled(+BottomUp, +Body0, -Body) the head row of THE REWRITE -% OF A CLAUSE (above). +%! head_scheduled(+BottomUp, +Body0, -Body) +% +% The head row of THE REWRITE OF A CLAUSE (above). head_scheduled([], Body, Body) :- !. @@ -1220,7 +1259,9 @@ conjoined([Lookups, Body0], Fast), conjoined([Settled, Inserted, Body0, Finished], General). -%! conjoined(+Goals, -Conjunction) the goals in order, `true` left out. +%! conjoined(+Goals, -Conjunction) +% +% The goals in order, `true` left out. conjoined(Goals, Conjunction) :- goals_kept(Goals, Kept), @@ -1266,8 +1307,10 @@ ; variable_member(Variable, Candidates) ). -%! occurrences_given(+TopLevel, -Condition) the condition of the fast path -% of a head: every top-level occurrence is given. +%! occurrences_given(+TopLevel, -Condition) +% +% The condition of the fast path of a head: every top-level occurrence is +% given. occurrences_given([Occurrence], Condition) :- !, @@ -1286,8 +1329,9 @@ (nonvar(Variable), (Variable = Id -> nonvar(Handle) ; true))) :- compound_name_arguments(Id, IdName, [_, Handle]). -%! occurrences_goal(+Occurrences, +Step, -Goal) the conjunction of one step -% over the occurrences, in the order given. +%! occurrences_goal(+Occurrences, +Step, -Goal) +% +% The conjunction of one step over the occurrences, in the order given. occurrences_goal([], _, true). occurrences_goal([Occurrence], Step, Goal) :- @@ -1331,8 +1375,10 @@ occurrence_goal(represented_before_call, occurrence(undetermined(_), Layer, Variable, _), hash_consing:represented(Layer, Variable)). -%! body_rewritten(+Body0, +File, -Body) the control constructs rewritten -% inside, every other goal by `goal_rewritten/3`. +%! body_rewritten(+Body0, +File, -Body) +% +% The control constructs rewritten inside, every other goal by +% `goal_rewritten/3`. body_rewritten(Goal, _, Goal) :- var(Goal), @@ -1378,8 +1424,9 @@ body_rewritten(Goal0, File, Goal) :- goal_rewritten(Goal0, File, Goal). -%! goal_rewritten(+Goal0, +File, -Goal) the body goal row of THE REWRITE -% OF A CLAUSE (above). +%! goal_rewritten(+Goal0, +File, -Goal) +% +% The body goal row of THE REWRITE OF A CLAUSE (above). goal_rewritten(Goal0, File, Goal) :- arguments_of_abstracted(Goal0, File, Called, BottomUp), @@ -1396,8 +1443,9 @@ conjoined([Inserts, Called], Fast), conjoined([Settled, Called, Finished], General). -%! terms_variables(+Occurrences, -Variables) the variables of the -% occurrences' layers other than their own Handles. +%! terms_variables(+Occurrences, -Variables) +% +% The variables of the occurrences' layers other than their own Handles. terms_variables(Occurrences, Variables) :- occurrences_terms(Occurrences, Terms), @@ -1421,8 +1469,10 @@ ), variables_without(Variables, Excluded, Rest). -%! listed_absent(+Term, +File, +Place) no listed constructor occurs in -% Term, a place the rewrite does not schedule; raises otherwise. +%! listed_absent(+Term, +File, +Place) +% +% No listed constructor occurs in Term, a place the rewrite does not +% schedule; raises otherwise. listed_absent(Term, File, Place) :- ( listed_occurs(Term, File) diff --git a/test/hash_consing.plt b/test/hash_consing.plt index 83bffa2..1e35f56 100644 --- a/test/hash_consing.plt +++ b/test/hash_consing.plt @@ -69,15 +69,18 @@ % setting's infinite width. :- set_setting(listing:line_width, 0). -%! test_directory(-Directory) the directory of this file, against which -% the fixtures and the snapshots are found. +%! test_directory(-Directory) +% +% The directory of this file, against which the fixtures and the snapshots +% are found. :- dynamic test_directory/1. :- prolog_load_context(directory, Directory), assertz(test_directory(Directory)). -%! test_file(+Relative, -File) Relative resolved against the directory of -% this file. +%! test_file(+Relative, -File) +% +% Relative resolved against the directory of this file. test_file(Relative, File) :- test_directory(Directory), @@ -96,12 +99,13 @@ user:message_hook(goal_failed(directive, _), warning, _) :- loading(Fixture), assertz(load_error(Fixture, directive_failed)). -%! fixture_loaded(+Fixture) the setup of a fixture's unit: the fixture -% file loaded, each error of the load recorded as -% `load_error(Fixture, Formal)`. Nothing is imported: the fixtures export -% predicates of the same name (`kind/2` in `inner_dispatch` and `patterns`), -% which one module could not import from both, and the tests call them -% qualified. +%! fixture_loaded(+Fixture) +% +% The setup of a fixture's unit: the fixture file loaded, each error of the +% load recorded as `load_error(Fixture, Formal)`. Nothing is imported: the +% fixtures export predicates of the same name (`kind/2` in `inner_dispatch` +% and `patterns`), which one module could not import from both, and the +% tests call them qualified. fixture_loaded(Fixture) :- fixture(Fixture, Relative, _, _), @@ -113,9 +117,11 @@ fixture_loaded(Fixture) :- % ---- rendering a fixture ---- -%! fixture_rendered(+Fixture, -Rendered) the errors recorded while the -% fixture loaded, one `load_error(Formal)` line each, then each predicate -% of the fixture's list with the clauses the load produced, as one string. +%! fixture_rendered(+Fixture, -Rendered) +% +% The errors recorded while the fixture loaded, one `load_error(Formal)` +% line each, then each predicate of the fixture's list with the clauses the +% load produced, as one string. fixture_rendered(Fixture, Rendered) :- fixture(Fixture, _, Module, Predicates), @@ -132,9 +138,10 @@ load_errors_printed(Fixture) :- format('load_error(~W)~n', [Formal, [quoted(true), numbervars(true)]]) )). -%! paths_shortened(+Term, -Shortened) every absolute file name in Term as -% its base name, so that the rendering does not depend on where the -% repository is checked out. +%! paths_shortened(+Term, -Shortened) +% +% Every absolute file name in Term as its base name, so that the rendering +% does not depend on where the repository is checked out. paths_shortened(Term, Term) :- var(Term), @@ -157,7 +164,9 @@ arguments_paths_shortened([Argument | Arguments], [Shortened | Shorteneds]) :- paths_shortened(Argument, Shortened), arguments_paths_shortened(Arguments, Shorteneds). -%! predicate_printed(+Module, +Name/Arity) the clauses as loaded. +%! predicate_printed(+Module, +Name/Arity) +% +% The clauses as loaded. predicate_printed(Module, Name/Arity) :- functor(Head, Name, Arity), @@ -193,8 +202,9 @@ arguments_baked_externalized([Argument | Arguments], [Printed | Printeds]) :- baked_externalized(Argument, Printed), arguments_baked_externalized(Arguments, Printeds). -%! snapshot_read(+Fixture, -Snapshot) the text of the fixture's file in -% `hash_consing_snapshots/`. +%! snapshot_read(+Fixture, -Snapshot) +% +% The text of the fixture's file in `hash_consing_snapshots/`. snapshot_read(Fixture, Snapshot) :- format(atom(Relative), 'hash_consing_snapshots/~w.txt', [Fixture]), @@ -203,18 +213,24 @@ snapshot_read(Fixture, Snapshot) :- % ---- the queries' helpers ---- -%! store_count(-Count) how many terms the store holds. +%! store_count(-Count) +% +% How many terms the store holds. store_count(Count) :- nb_getval(hash_consing_store, Trie), trie_property(Trie, value_count(Count)). -%! spelling_count(-Count) how many shape atoms the library has spelled. +%! spelling_count(-Count) +% +% How many shape atoms the library has spelled. spelling_count(Count) :- nb_getval(hash_consing_spellings, Trie), trie_property(Trie, value_count(Count)). -%! shape_indexed(+Head) the just in time indexer built an index on the -% first argument of the first argument, which is the shape. +%! shape_indexed(+Head) +% +% The just in time indexer built an index on the first argument of the first +% argument, which is the shape. shape_indexed(Head) :- predicate_property(Head, indexed(Indexes)), member(Index, Indexes), @@ -226,48 +242,57 @@ shape_indexed(Head) :- called_repeatedly(Goal) :- forall(between(1, 20, _), ( call(Goal) -> true ; true )). -%! answers_its_term(+Term) Term interns to an Id that externalizes back to -% Term. +%! answers_its_term(+Term) +% +% Term interns to an Id that externalizes back to Term. answers_its_term(Term) :- intern(Term, Id), externalized(Id, Back), Back == Term. -%! interned_forever(+Round, +Index) interns `time_probe(Round, Index, -% leaf)` and the probes after it until a limit stops it, recording in -% the global variable `interrupted_intern_count` the last Index interned. +%! interned_forever(+Round, +Index) +% +% Interns `time_probe(Round, Index, leaf)` and the probes after it until a +% limit stops it, recording in the global variable +% `interrupted_intern_count` the last Index interned. interned_forever(Round, Index) :- intern(time_probe(Round, Index, leaf), _), nb_setval(interrupted_intern_count, Index), Next is Index + 1, interned_forever(Round, Next). -%! numbered_template(+Prefix, +Number, -Template) the template -% `Prefix_Number(_)`. +%! numbered_template(+Prefix, +Number, -Template) +% +% The template `Prefix_Number(_)`. numbered_template(Prefix, Number, Template) :- format(atom(Name), '~w_~d', [Prefix, Number]), functor(Template, Name, 1). -%! templates_declared_one_by_one(+Templates, +Worker) each template -% declared alone, in the order of the list. +%! templates_declared_one_by_one(+Templates, +Worker) +% +% Each template declared alone, in the order of the list. templates_declared_one_by_one(Templates, _) :- forall(member(Template, Templates), declared([Template])). -%! thread_stores(-Stores) the store and the spellings of this thread, the -% two global variables of prolog/hash_consing.pl. +%! thread_stores(-Stores) +% +% The store and the spellings of this thread, the two global variables of +% prolog/hash_consing.pl. thread_stores(stores(Store, Spellings)) :- nb_getval(hash_consing_store, Store), nb_getval(hash_consing_spellings, Spellings). -%! thread_stores_installed(+Stores) Stores installed in this thread, which -% then interns into the same tries. +%! thread_stores_installed(+Stores) +% +% Stores installed in this thread, which then interns into the same tries. thread_stores_installed(stores(Store, Spellings)) :- nb_setval(hash_consing_store, Store), nb_setval(hash_consing_spellings, Spellings). -%! terms_interned_with_stores(+Stores, +Numbers, +Worker, -Ids) the Id of -% `concurrently_interned(Number)` for each of Numbers, interned by this -% thread into Stores. +%! terms_interned_with_stores(+Stores, +Numbers, +Worker, -Ids) +% +% The Id of `concurrently_interned(Number)` for each of Numbers, interned by +% this thread into Stores. terms_interned_with_stores(Stores, Numbers, _, Ids) :- thread_stores_installed(Stores), maplist(number_interned, Numbers, Ids). @@ -275,9 +300,10 @@ terms_interned_with_stores(Stores, Numbers, _, Ids) :- number_interned(Number, Id) :- intern(concurrently_interned(Number), Id). -%! shapes_interned_with_stores(+Stores, +Numbers, +Worker, -Ids) the Id of -% `concurrently_shaped(shape_Number, Worker)` for each of Numbers: a term -% of this thread's own, whose shape every thread spells alike. +%! shapes_interned_with_stores(+Stores, +Numbers, +Worker, -Ids) +% +% The Id of `concurrently_shaped(shape_Number, Worker)` for each of Numbers: +% a term of this thread's own, whose shape every thread spells alike. shapes_interned_with_stores(Stores, Numbers, Worker, Ids) :- thread_stores_installed(Stores), maplist(shape_interned(Worker), Numbers, Ids). @@ -288,9 +314,10 @@ shape_interned(Worker, Number, Id) :- % ---- the fixtures ---- -%! fixture(?Fixture, ?File, ?Module, ?Predicates) a fixture file, relative -% to this file's directory, the module it defines, and the predicates its -% rendering shows. +%! fixture(?Fixture, ?File, ?Module, ?Predicates) +% +% A fixture file, relative to this file's directory, the module it defines, +% and the predicates its rendering shows. fixture(steps, 'hash_consing_fixtures/steps.pl', steps, [step/2, callee/2, built/2, constant/1]). diff --git a/test/hash_consing_fixtures/patterns.pl b/test/hash_consing_fixtures/patterns.pl index d850625..9c68b13 100644 --- a/test/hash_consing_fixtures/patterns.pl +++ b/test/hash_consing_fixtures/patterns.pl @@ -3,8 +3,7 @@ % of them matches stays a plain compound; the occurrences below fall in the % three classes of the rewrite. :- module(patterns, [kind/2, size/2, wrapped/2, first/2, built/2, unbound_built/1]). -:- use_module(library(hash_consing), []). -:- hash_consing:rewritten([app(abs(_), _), app(app(*, _), _), app(_, ref(_)), abs(_), ref(_)]). +:- include(patterns_templates). % Must intern, every instance taking the first template: the shape `abs/1` % is written into the head. diff --git a/test/hash_consing_fixtures/patterns_templates.pl b/test/hash_consing_fixtures/patterns_templates.pl new file mode 100644 index 0000000..e050590 --- /dev/null +++ b/test/hash_consing_fixtures/patterns_templates.pl @@ -0,0 +1,4 @@ +% Fixture of test/hash_consing.plt: the templates of `patterns.pl`, kept in a +% file of their own that every file handing these terms to another includes. +:- use_module(library(hash_consing), []). +:- hash_consing:rewritten([app(abs(_), _), app(app(*, _), _), app(_, ref(_)), abs(_), ref(_)]).