1:- module( options, [ 
    2              options/2, 
    3              options/3,
    4              options_append/3, 
    5              options_append/4,
    6              options_call/2, options_call/3,
    7              options_debug_topic/3,
    8              options_debug/3, 
    9              options_propagate/4,
   10              options_restore/2,
   11              options_return/2,
   12              options_version/2
   13            ] ).

Options handling and processing.

This is a stoics.infrastructure pack for handling option arguments. The main concept is to treat options as naive Prolog lists which the programmer can manipulate and specialise if they need to, while providing a small number of predicates that manage basic common operations on options. Options are particularly important in the context of SWI packs, as making code publicly available to others often involves allowing for variations in the behaviour of the code.

The library provides simple extensions to the basic list manipulation predicates. In many cases it is just the error handling that is the main difference to standard predicates.

Technically the library is designed on the semantics of memberchk/2. Looking for an Option in a list of options, memberchk/2 will return the leftmost match. Library(options) sees options as a concatenation (append/3) of the user provided options (arguments for hereon) and the defaults provided by the predicate.

The default option values for a predicate are given by a predicate of the same name but postfixed by '_defaults'. The library also allows for reading user specific default options by reading profiles from a file located at $HOME/.pl/<pred_name>.pl, if that file exists. Each options file should have a number of option terms given as facts.

Some distinctive features of pack(options)

For an example see program options_example_sort_defaults.pl in examples directory.

?- edit( pack(options/examples/ex_sort) ).

?- [pack(options/examples/ex_sort)].

?- ex_sort( [a,b,e,c,b], Ord, true ).
Ord = [a, b, c, e].
?- ex_sort( [a,b,e,c,b], Ord, debug(true) ).
% Input list length: 5
% Output list length: 4
Ord = [a, b, c, e].
?- ex_sort( [a,b,e,c,b], Ord, order(>) ).
Ord = [e, c, b, a].
?- ex_sort( [a,b,e,c,b], Ord, duplicates(true) ).
Ord = [a, b, b, c, e].

Create file $HOME/.pl/ex_sort.pl with content order(>).

?- ex_sort( [a,b,e,c,b], Ord, true ).
Ord = [e, c, b, a].

Default for user is now order(>) which can still be over-ridden at invocation

?- ex_sort( [a,b,e,c,b], Ord, order(<) ).
Ord = [a, b, c, e].

Pack info

Predicates

Thanks to Jan Wielemaker for fixing an issue with expanding the $HOME variable and missing curly brackets in the errors DCG (2016/11/14).

author
- nicos angelopoulos
version
- 0.2.0 2015/7/5
- 0.4.0 2016/2/29
- 0.5.0 2017/3/10
- 1.0 2018/3/18
- 1.1 2018/4/8
- 1.2 2019/4/18
- 1.3 2020/9/18
- 1.4 2021/1/22
- 1.5 2022/12/29
See also
- http://www.stoics.org.uk/~nicos/sware/options

*/

  114:- use_module(library(lists)).  % append/3, select/3,...
  115:- use_module(library(apply)).  % partition/4...
  116:- use_module(library(debug)).  % /3.
  117:- use_module(library(filesex)).% directory_file_path/3,...
  118
  119:- use_module(library(lib)).  120:- lib(source(options), homonyms(true)).  121        % this shouldn't be necessary but SWIPL (at least 7.3.31-9)
  122        % "looses" the prolog_load_context( module, _ ) value when 
  123        % requires/1 is used from auxilary files within the pack
  124
  125:- lib(pack_errors).  126
  127:- lib(options_auxils/0).  128:- lib(options_append/4).  129:- lib(options_append/4).  130:- lib(options_debug/3).  131:- lib(options_propagate/4).  132:- lib(options_restore/2).  133:- lib(options_return/2).  134:- lib(options_call/2).    % and /3.
  135:- lib(options_errors/0).  136:- lib(options_debug_topic/3).  137:- lib(end(options)).
 options_version(-Version, -Date)
Current version and release date for the library.

Currently:

?- options_version( Vers, Date ).
Date = date(2022,12,29),
Vers = 1:5:0.

*/

  150% options_version( 0:4:0, date(2016,2,29) ).
  151options_version( 1:5:0, date(2022,12,29) ).
  152
  153% options_defaults( [rem_opts(_),en_list(false),ground(false)] ).
  154options_defaults( [en_list(false),ground(false)] ).
 options(+Required, +Opts)
 options(+Required, +Opts, +OptionsOpts)
This should more naturally be option/2 but as this might cause confusion with Swi's own option library. Required can be a single or list of terms.

Opts can also be non list as it is passed through en_list/2.

Options

en_list(Enlist=false)
when true it enlists the returning argument
ground(Ground=false)
should the selected option required to be ground, and what to do if not
false
dont do anything
true
fail
error
throw error
true(TruthValue)
only variable is allowed, if present the call always succeeds and TruthValue is bound to either true or false depending on underlying success of options/2 call
rem_opts(RemOpts)
RemOpts is Opts after all functor/shape matching mentions of Required have been removed.

The predicate fails silently if the first Required option with equivalent "shape" in Opts fails to pattern match (unlike classic memberchk/2).

 ?- options( x(y), [x(x)] ).
 false.
 
 ?- options( x(y), [x(x),x(y)] ).
 false.

 ?- options( x(X), [a(b),c(d),x(y),x(x)] ).
 X=y.

 ?- options( [a(X),c(b)], [a(b),x(x),b(c)] ).
 ERROR: Required option: c(b), not present in options: [a(b),x(x)]
 % Execution Aborted
 
 ?- options( x(X), [a(b),c(d),x(y),x(x)], rem_opts(Rem) ).
 X = y,
 Rem = [a(b), c(d)].

 ?- options( x(X), [a(b),c(d),x(y),x(x)], en_list(true) ).
 X= [y].

 ?- options( a(A), [a(X),b(c)], ground(error) ).
 ERROR: pack(options): Option should be ground, but found: a(_G1470), in options: [a(_G1470),b(c)]
 ?- options( a(A), [a(X),b(c)], ground(true) ).
 false.
 
 ?- options( a(A), [a(X),b(c)] ).
 A = X.
 
 ?- options( a(A), [a(X),b(c)], ground(false) ).
 A = X.
 
 ?- options( a(b), [a(a),a(b),b(c)], true(T) ).
 T = fail.
 
 ?- options( a(A), [a(a),a(b),b(c)], true(T) ).
 A = a,
 T = true.
 
 ?- options( a(a), [a(a),a(b),b(c)], true(T) ).
 T = true.
 
author
- nicos angelopoulos
version
- 0.2 2015/01/16
- 0.3 2015/12/06 changed 3rd argument to Options of its own invocation
  232options( Needed, Opts ) :-
  233    options( Needed, Opts, [] ).
  234
  235options( ReqS, OptS, OwnOptS ) :-
  236    options_append( options, OwnOptS, OwnOpts ),
  237    options_en_list( ReqS, Reqs ),
  238    options_en_list( OptS, Opts ),
  239    memberchk( en_list(Enlist), OwnOpts ),
  240    debug( fixme, 'Use type checking on: ~a', Enlist ),
  241    options_required_truth_value( Reqs, Opts, Enlist, OwnOpts, Rem ),
  242    (memberchk(rem_opts(Rem),OwnOpts) -> true; true ).
  243
  244options_required_truth_value( Reqs, Opts, Enlist, OwnOpts, Rem ) :-
  245    options_required( Reqs, Opts, Enlist, OwnOpts, Rem ),
  246    !,
  247    ( memberchk(true(true),OwnOpts) -> true; true ).
  248options_required_truth_value( _Reqs, Opts, _Enlist, OwnOpts, Opts ) :-  % Rem = Opts here
  249    memberchk( true(fail), OwnOpts ).
  250
  251options_required( [], Opts, _Enlist, _OwnOpts, Opts ).
  252options_required( [Needed|T], Opts, Enlist, OwnOpts, Rem ) :-
  253    options_option_required( Opts, Needed, Enlist, OwnOpts, Rest ),
  254    options_required( T, Rest, Enlist, OwnOpts, Rem ).
  255
  256options_option_required( Opts, Needed, Enlist, OwnOpts, Rest ) :-
  257    functor( Needed, Tname, Tarity ),
  258    functor( Termplate, Tname, Tarity ),
  259    option_select_functor( Opts, Tname, Tarity, Sel, Rest ),
  260    memberchk( Termplate, Sel ),
  261    !,
  262    memberchk( ground(Ground), OwnOpts ),
  263    ( ground(Termplate) -> IsGround = true; IsGround = false ),
  264    option_arg_ground( IsGround, Ground, Termplate, Opts ),
  265    option_arg_enlist( Enlist, Termplate, Needed ).
  266options_option_required( Opts, Needed, _Enlist, _OwnOpts, _Rest ) :-
  267    PeOpts = [pred(options/2),pack(options)],
  268    throw( pack_error(opt_required(Needed,Opts)), PeOpts ).
 option_arg_ground(+Ground, ?Termlate)
Check groundness of found Option.

*/

  275option_arg_ground( true, _Ground, _Termlate, _Opts ).
  276option_arg_ground( false, Ground, Termlate, Opts ) :-
  277    options_arg_non_ground( Ground, Termlate, Opts ).
  278
  279% options_arg_non_ground( true, Termlate, Opts ) :- fail
  280options_arg_non_ground( false, _Termlate, _Opts ).  % Termlate is NOT required to be ground
  281options_arg_non_ground( error, Needed, Opts ) :-
  282    PeOpts = [pred(options/2),pack(options)],
  283    throw( pack_error(opt_mustbe_ground(Needed,Opts)), PeOpts ).
  284
  285option_arg_enlist( true, Termlate, Needed ) :-
  286    Termlate =.. [Name,Arg1|Args],
  287    options_en_list( Arg1, Enlist1 ),
  288    Needed =.. [Name,Enlist1|Args].
  289option_arg_enlist( false, Needed, Needed ).
  290
  291option_select_functor( [], _Tname, _Tarity, [], [] ).
  292option_select_functor( [H|T], Tname, Tarity, Sel, Rest ) :-
  293    ( functor(H,Tname,Tarity) -> 
  294        Sel = [H|TSel],
  295        Rest = TRest
  296        ;
  297        Sel = TSel,
  298        Rest = [H|TRest]
  299    ),
  300    option_select_functor( T, Tname, Tarity, TSel, TRest )