30 December 2015

Introduction

Modularity is the cornerstone of modern software development. Good code, in any programming language, is arranged in small collections of related data structures and functionality which are then accessed in a consistent way in other similar collections.

Prolog is a very old language. It was first created before modular software development was the standing religion and it was not designed for this degree of modularity. Modules as a concept had to be retrofitted to a language design which almost, but not quite, actively resisted being made modular.

Prolog, too, was (and remains) a highly fragmented language. There have been dozens of mutually incompatible dialects of the language, each of which approached modularity from a different approach. Even nowadays, when there is a standard for Prolog modules, there is not 100% compatibility in module handling across dialects.

This tutorial will introduce the module system implemented in SWI Prolog in specific. It builds upon the documentation provided by SWI Prolog and gives concrete motivations and solutions to real-world computing problems to aid in comprehension.

Target Audience

This tutorial is aimed at people with some knowledge of Prolog and some experience (but not a lot!) with SWI Prolog who want to start using Prolog for more than scholastic toy applications. A further desirable condition is a willingness to experiment with provided samples to ensure comprehension of some often-slippery notions.

Requirements

To work through this tutorial you will require the following:

  • a working installation of SWI Prolog;

  • an open shell with SWI Prolog’s interactor running;

  • the reference documentation for SWI Prolog’s modules open and available in your browser;

  • the apply.pl module source code also open in your browser.

Caution

While I strongly recommend against this, if you insist on merely reading code instead of actively participating in its creation (a far better way to learn!), you will have to have a copy of the source code (available at the end) to try out some of the exercises and see their results.

If you choose this latter (still not recommended) option, note that fixedadd.pl is the version of add.pl that solves the problem we faced and that fixed.pl is the version of the resulting program that actually works. You’ll understand what this means when you get to the appropriate part of the tutorial.

Tip You probably really do want to write the code yourself, just to get it into your motor memory.

License

This tutorial is ©2013-2015 Michael T. Richter. It comes without any warranty of any kind, including, but not limited to, that of accuracy, of utility, or even of good taste to the extent permitted by applicable law. You can redistribute it and/or modify it under the terms of the Do What The Fuck You Want To Public License, Version 2.

Motivation

In traditional Prolog systems all predicates are placed into one, single namespace. Any predicate may be referenced by any other predicate anywhere in a software system. This, the very antithesis of modularity, leads to software systems which are very difficult to maintain, to wit:

  1. It is very difficult to reason about (and thus understand) code which can be accessed from anywhere in the system;

  2. Source dependencies are difficult to work out;

  3. It is more difficult to document intended use if there is no good mechanism identifying which parts of code are supposed to be referenced and which are mere implementation details.

SWI Prolog’s module system aids in all of these concerns.

  1. By encapsulating related predicates into modules, it is much simpler to understand and reason about the implementing code;

  2. By requiring explicit imports of needed modules, dependencies are easy to work out and, perhaps more importantly, are enforced by the tools;

  3. By defining an interface, it clearly identifies which predicates are intended for direct use and which are only implementation details----changes to implementation predicates cannot break clients which properly observe access protocols.

Basic Module Use

The basics of module use are very simple and knowledge of them will suffice for approximately 99.44% of your coding needs.

Module declaration

Modules are declared through the module directives. Here is an example of such a directive taken from apply. It has been elided for instructional purposes. Consult the file for full details.

Example 1. module directive
:- module(apply,          % 1
          [ include/3,    % 2
            exclude/3,
            % ...
          ]).
1 The module directive first accepts an atom with the module’s name.
2 The second argument is a list of publicly accessible ("exported") predicates.

In this case the module is named apply and it exports, among (many) others the predicates include/3 and exclude/3.

Note
Dialect parameter

There is a module/3 directive which allows you to specify the dialect of Prolog this module expects. This is advanced usage and is out of scope for this tutorial. Users wishing to exploit this feature should read the manual on dialect compatibility.

Exercise 1: module directive

Make a small Prolog module, add, that exports the predicates add_all/2 and add_some/3.

  • add_all/2 should succeed iff the first parameter is a list of integers whose sum is equal to the second.

  • add_some/3 should succeed iff the first parameter is a list of integers, the second a Goal applied to each member of the first and the final is a number equal to the sum of all members of the first parameter for which the goal in the second succeeded.

example of use
?- add_some([1,2,3,4,5], <(3), 9).     % => true.

Work out what your module directive for this module will look like and insert it into your code.

Note If you want to implement these predicates now that’s fine, but Exercise 1 at this point is writing out the module directive. A later exercise will involve implementation after you see an example of how such an implementation could be made.

Module implementation

Returning now to apply.pl, the SWI Prolog module we took the module declaration from earlier, here is the implementation of the exclude/3 predicate:

Example 2. Predicate implementation
exclude(Goal, List, Included) :-   % 1
  exclude_(List, Goal, Included).  % 2

exclude_([], _, []).               % 3
exclude_([X1|Xs1], P, Included) :-
  (   call(P, X1)
  ->  Included = Included1
  ;   Included = [X1|Included1]
  ),
  exclude_(Xs1, P, Included1).
1 exclude/3 is the only exported predicate from this snippet of code.
2 It is entirely implemented in terms of a helper predicate exclude_/3.
3 Inspection of that implementation shows that it’s a performance hack. The arguments have been re-ordered from an order which makes more sense to a human into an order that suits SWI Prolog’s indexing system better.

Without the module system in place, a client of this code could choose, for some unfathomable reason (perhaps a misguided attempt at premature optimization), to use the exclude_/3 predicate directly. Thus, if a better way to implement exclude/3 were to be found, one of three unpleasant alternatives would have to be considered:

  • The change could break existing code, requiring all clients to be updated;

  • The change could be made with the old exclude_/3 predicate being supported in some way for backwards-compatibility reasons;

  • The change could be skipped as being too much work for too little gain.

Because, however, apply is a module, any implementation detail is subject to change without worrying about clients being disrupted in any way.

Tip Clients can still access exclude_/3 (for which c.f. below), but if they choose to do so, they are explicitly breaking the module barriers and thus are responsible for their own rewrites should implementation predicates change in the future.
Exercise 2: apply.pl

Examine the apply module’s module directive and compare it to its other implementation predicates.

<foreshadowing>
See if you can find any unusual declarations that seem related to modules but that you can’t yet figure out.
</foreshadowing>

Using modules

Get your copy of SWI Prolog fired up if you haven’t already done so and enter the following:

Example 3. Sample of use (session)
?- use_module(library(apply)).
?- exclude(<(3),[1,2,3,4,5],I).     % 1
?- exclude_([1,2,3,4,5], <(3), I).  % 2
1 exclude/3 will, if you’ve typed it in correctly, bind I = [1,2,3].
2 exclude_/3 isn’t even visible to your namespace.

Obviously exclude_/3 is working (since exclude/3 uses it), but you cannot access it in your namespace (which defaults to the user module) because it was not exported from the apply module. The module’s author (Jan Wielemaker) is free to change the implementation of exclude/3 however he sees fit without having to worry about your code breaking.

Exercise 3: Using modules

Since you have a nice module add already (you did Exercise 1, right?), it would be nice to test it out. Implement add_all/2 and add_some/3 now however you’d like. (Using the apply module is one way to do it, but the predicates involved are sufficiently trivial that you might want to do it by hand.)

The semantics of </2 are a little tricky, however, so it would be best if we used a more straightforward predicate for our test. Create a module filters that exports the predicate less_than_three/1. This predicate should succeed if the passed-in parameter is an integer less than three. The following code should suffice (plus, of course, the module boilerplate):

less_than_three(N) :-
  integer(N),
  N < 3.

Now enter the following at the interactor and observe what happens.

?- use_module(add).
?- use_module(filters).
?- add_some([1,2,3,4,5], less_than_three, S).

Everything seems to work well. Let’s make a file broken.pl with these contents:

% broken.pl
:- module(broken, []).
:- use_module(add).
:- use_module(filters).

go :-
  add_some([1,2,3,4,5], less_than_three, S),
  writeln(S).

When we execute this from the command line (swipl -q -t broken:go,halt -f broken.pl), something different happens. See if you can figure out why.

Modules and Meta-Predicates

The unexpected failure of the previous exercise stems from the whole ugly topic of meta-predicates. Meta-predicates are an unfortunate side effect of two problems in Prolog:

  • The language is very old and designed at a time when modular programming was in its infancy (and not widely adopted).

  • Higher order programming was also an afterthought in the language design.

Meta-predicate handling is simple enough, it’s just typically poorly explained and unexpected. For example having less_than_three working fine from the console but not from the broken module is one of these "wait…​what?!" moments that plague some of the hairier parts of Prolog.

What are meta-predicates?

In brief, any predicate that accepts as an argument a goal is a meta-predicate. They are the chief mechanism Prolog systems have for higher-order programming. Our add_some/3 predicate is a meta-predicate because it uses a passed-in goal to do its magic. Almost every predicate in apply.pl is a meta-predicate in that they all do things with passed-in goals.

Why do we need them?

meta-predicates are the only mechanism Prolog systems have for doing higher-order programming. The way they work, however, does not mix well with SWI Prolog’s (and others') module systems. The problem is very simple. Looking at our add_some/3 example, the predicate takes three parameters, one of which is a filtering goal. We passed in less_than_three/1 as our goal, so somewhere deep inside the implementation of add_some/3 there is a call (using the call/2 predicate in this case) of less_than_three/1.

But…​

How is the add module supposed to know we meant filters:less_than_three/1? There may be a dozen modules in our software system (let’s hope not!) with less_than_three/1 predicates.

ASSUME = ASS + U + ME

So here the language assumes that, since the predicate is in the add module that we must mean that we want add:less_than_three. After all the only module whose predicates it knows about is add. (We didn’t import any other modules in our source, did we?) This assumption proves false and we get that ugly error message:

ERROR: add:filter_list/3: Undefined procedure: add:less_than_three/1
The cheap way around it

This could be easily solved by invoking the add_some/3 predicate thusly:

add_some([1,2,3,4,5], filters:less_than_three, S).

This will work just fine. It does, however, make predicate references rather verbose and it would add a lot of line noise to the experience of using some of the more involved meta-predicates. (In addition there are other reasons, explained below, why this approach is undesirable.) If only there was some way to tell the compiler or interpreter that this one argument needs to be treated specially!

How do we declare them?

As it so happens, there is such a way. We would only need to add the following line to our add.pl file:

:- meta_predicate add_some(`, 1, -).

It really is that simple.

Exercise 4: Try it

Add that line in the add.pl file you have (just beneath the module/2 directive) and re-run the broken.pl program. If you are being lazy and not actually typing code in yourself, this is where we look at using the fixedadd.pl and fixed.pl files, but please, don’t go this lazy route.

A brief reference

The full documentation for the meta_predicate/1 directive is very complete but, sadly, is not very helpful if you don’t already know what’s going on under the covers. In addition, the prose of the full documentation is …​ not the best ever put to bits. Here’s my try at fixing this.

0..9

The integers are used to tell the compiler that the parameter at the given position is module-sensitive. It also says that this parameter will be called with n more arguments than have already been provided. Note that this does not mean that the arity of the goal must be n. It means the "remaining" arity of the goal must be n.

In our example above, we had 1 in the location of the passed-in goal. This means that we expect to call it with precisely one parameter. This could be less_than_three/1 as above, but it could also be </2 if we like, provided that we give </2 one of its arguments first. If, in short, we passed just < as the goal, we would have an arity mismatch, but if we passed <(3) that would be fine.

:

The colon is simpler. It merely tells the compiler that the provided goal is module-sensitive, but that it is not a predicate which will be called using the call/n suite of built-in predicates.

Consider this example code:

:- module(junk, [print_two_terms/2]).
:- meta_predicate print_two_terms(`,:).
print_two_terms(A, B) :-
  writeln(A),
  writeln(B).

If this code is exercised in the interactor, the following transpires:

?- use_module(junk).
?- print_two_terms(foo, bar).
foo
user:bar
true.

As you can see, the second parameter, flagged with :, has had the module pre----pended to it.

`, ----, ?

These are "mode" declarations which mean "bound", "unbound" and "unspecified" (either bound or not) respectively. Their sole role, beyond documenting intent, is to tell the compiler that these parameters are not module-sensitive.

Note
The rest of the gang

The remaining meta-predicate symbols (^ and //) fall into the "advanced use" category and are out of scope of this tutorial. Details can be found in the official documentation if they are needed. (They won’t be needed.)

interpreting our meta-predicate
:- meta_predicate add_some(`, 1, -).

Looking at our declaration, we can now see that add_some/3 expects a bound ("in") parameter in the first position, a goal which accepts a single additional argument in the second and an unbound ("out") parameter in the third.

More notes on 0..9 in meta-predicate declarations

It is important to understand the relationship between the call/n predicate suite and the integer meta-predicate argument values. To this end it is best to look at how call/n operates. This can be most easily demonstrated with a few examples:

sample session
% extraneous messages elided for clarity
% formatting used to highlight structure better
?- use_module(library(apply)).
?-      include(integer, [1,2,b,4,5], I).        % 1
I = [1, 2, 4, 5].
?- call(include(integer, [1,2,b,4,5], I)     ).  % 2
I = [1, 2, 4, 5].
?- call(include(integer, [1,2,b,4,5]),      I).  % 3
I = [1, 2, 4, 5].
?- call(include(integer),      [1,2,b,4,5], I).  % 4
I = [1, 2, 4, 5].
?- call(include,      integer, [1,2,b,4,5], I).  % 5
I = [1, 2, 4, 5].
1 include/3 is directly called with all three arguments.
2 include/3 is indirectly called via call/0 with all three arguments in the goal.
3 include/3 is indirectly called via call/1 with two arguments in the goal and one provided as an extra.
4 include/3 is indirectly called via call/2 with one argument in the goal and two provided as extras.
5 include/3 is indirectly called via call/3 with no arguments in the goal and three provided as extras.

The 0..9 meta-predicate argument declaration refers to which version of call/n (or equivalent) is being invoked. 0 means no extra arguments are expected and thus call/0 is going to be invoked. 9 means 9 extra arguments are expected and thus call/9 is going to be invoked, etc.

Exercise 5: Try more

Open apply.pl and look over its meta_predicate/1 declarations. Compare the declarations to the predicate implementations and see how each predicate works. Test your intuitions by trying a few using good and bad goals. How does the compiler handle things?

So why did it work from the interactor?

So let’s go waaaaaaaaaaaaaaaay back to where we had code that worked fine in the interactor suddenly stop working when put into a module. What went on there?

What went on there, sadly, was SWI Prolog being too nice to us. There are two specially-treated modules in the SWI Prolog system: system and user. system contains all built-in predicates. There is no import module for it; you can’t use_module(system).

user is the initial working space of the user. It automatically imports system (thus making all built-in predicates available). It is also automatically imported into every other module. This means every predicate imported into user is also imported into every other module.

By default the interactor is in the user module. This when we did this sequence…

?- use_module(add).
?- use_module(filters).
?- add_some([1,2,3,4,5], less_than_three, S).

…all of the predicates exported from add and filters were available to each other. Thus add_some/3 knew where to find less_than_three/1.

When, however, we put this code into its own module…

% broken.pl
:- module(broken, []).
:- use_module(add).
:- use_module(filters).

go :-
  add_some([1,2,3,4,5], less_than_three, S),
  writeln(S).

…we explicitly ran the code without the user module being involved. The result was, as could be expected, confusion on the part of the runtime; it was also the reason why we needed to declare add_some as a meta_predicate.

Putting it all together

Exercise 6: Final task: fixing add.pl

There is a bug in add.pl in that its predicates, defined as working on integers only, do not actually enforce this contract. Modify the add_all/2 and add_some/3 predicates to check for this constraint before performing any further calculations. Make good use of helper predicates without changing the public interface in any way.

Note No solution has been provided for this exercise.

Stupid Module Tricks

There are a myriad of nooks and crannies in the SWI Prolog module system. Many of them are artifacts of Prolog itself and many others are likely artifacts of compromises as people argued about how things should be done.

Bypassing the module system

Warning Do not do this!

One of the first tricks to know is that it is possible to turn even modular Prolog code back into the "use any predicate anywhere" Prolog of the days of yore. All you need to do is prepend the module name to a predicate call:

?- apply:include_([1,2,3,4,5], >(3), I).
I = [1, 2].

include_/3 is not exported by the apply module and we didn’t even call use_module(library(apply)) anyway. We could, nonetheless, freely call the implementation predicates as if there were no module system in place.

Warning No really, do not do this!

Multi-file predicates

Typically predicates are written in such a way that all related predicates are in one source file. consult/1, upon loading a file, will redefine predicates which share the same functor/arity as those already defined.

In several cases, however, this behaviour is undesirable. Consider, as a simple example, the license module. If you wish to define your own license, you have to provide an override of license:license/3 like this:

license:license(wtfpl, lgpl,
                [ comment('Do What The Fuck You Want To Public License'),
                  url('http://www.wtfpl.net/txt/copying')]).
:- license(wtfpl).

This will clearly not work, however, because in adding wtfpl to the license declarations you’re also deleting swipl, gpl and lgpl (among others). The code must be fixed to look like this:

:- multifile license:license/3.
license:license(wtfpl, lgpl,
                [ comment('Do What The Fuck You Want To Public License'),
                  url('http://www.wtfpl.net/txt/copying')]).
:- license(wtfpl).

Now you are defining your own license without deleting existing ones.

Limited imports

In most cases when importing you want to import all exported predicates. This may not always be the case, however:

  • You may not wish to clutter up your namespace;

  • You may have name clashes with your own predicates.

There is a use_module/2 predicate which permits this if necessary.

importing a subset of predicates
:- use_module(library(apply)), [include/3]).

This will only import the include/3 predicate from apply.

renaming predicates
:- use_module(library(apply)), [include/3,
                                exclude/3 as reject]).

This will only import include/3 and exclude/3. Furthermore, exclude/3 can only be called as reject/3.

importing all predicates except a select few
:- use_module(library(apply)), except([partition/4, partition/5])).

This will import all the predicates of apply except for the two versions of partition specified.

The predicates which are not imported can still be accessed as module:predicate/arity.

Important
This has surprising exceptions!

SWI Prolog tries its best to be a friendly environment to developers. It sometimes tries too hard in my opinion. use_module/2 collides headlong with one of these: autoloading libraries.

If you tried the above examples in your own code you’d find they all do absolutely nothing. In the first example you’d still be able to use partition/4 without qualifying it by module, for example, even though in one case you’d specifically excluded it!

This behaviour is, in my opinion, counter-productive in that it allows modular errors to slip into code silently, it breaks explicit exclusions, and it impedes efforts to port code to other Prolog environments which do not do this nearly-predatory levels of hand-holding.

There are two options open to you:

  1. Read the documentation for the auto loader and learn it inside and out. Be absolutely, 100% positive of what it does and when it does it. Oh, right, and be aware that your clients may not have the auto loader turned on, or may have the autoload_path/1 predicate adding even more to their environments; or

  2. Turn off auto loading in your environment by inserting the following code into your .plrc file (or equivalent): :- set_prolog_flag(autoload,false).

The user module

The general work flow of Prolog programming involves putting predicate declarations into source files and then consulting them to bring them into the user module for the interactor. For testing quick, once-off predicates, however, this is frequently undesirable. Consider this session:

?- [user].
|: my_predicate :- writeln('I did it!').
|: % user://1 compiled 0.00 sec, 2 clauses  1
true.
?- my_predicate.
I did it!
true.
1 An EOF (Ctrl+D for Linux or Ctrl+Z for Windows) has to be inserted here from the console.

As you can see, a user-supplied predicate has been entered at the interactor. While this is not as convenient as a full REPL like the Lisps provide, it is still fine for doing quick tests, etc. and certainly superior to using assert* to insert predicates. It is, however, a very limited environment with, for example, no editing facilities-typos are a pain to correct-and thus not really suited to serious work.

You’ll need a text editor still.

Module properties

Reflection can be performed even on the module system. The full documentation, as usual, provides the full details, but this short overview gives you some of the use cases.

Checking the current module(s)

current_module/1 can be used to check which modules are currently defined in your scope. For example, from the top level of the interactor:

?- current_module(M).
M = prolog_history ;
M = apply ;
M = predicate_options ;
M = base32 ;
M = ansi_term ;
M = link_xpce ;
M = pairs ;
M = error ;
M = edit ;
M = lists ;
M = user ;
M = system ;
M = prolog ;
M = pce_swi_hooks ;
false.
Checking the proprties of a given module

module_property/2 can be used to check on the type and capabilities of a module. The full options are listed in the documentation, but some of the potentially useful features are demonstrated below:

find the source file of a given module
?- module_property(lists, file(F)).
F = '/usr/local/lib/swipl----6.3.15/library/lists.pl'.
find the predicates and operators exported by a module.
% reformatted slightly for clarity
?- module_property(lists,exports(E)).
E = [proper_length/2, subtract/3, member/2, same_length/2, subset/2, union/3,
     nth0/4, last/2, ... / ...|...].
?- module_property(lists,exported_operators(O)).
false.

From this example we can see that lists exports several (many!) predicates but no operators.

Dynamic modules

Modules can be created at any time. Typical work flow defines modules at load time using module/2 and these are not changed at run time. It is possible, however, to create modules at run time simply by asserting a predicate with a module:

?- assertz(runtime_rules:room_contents(Room, Contents)).
?- runtime_rules:listing.
:- dynamic room_contents/2
room_contents(_, _).
true.
?- room_contents(a,b).
ERROR: '$execute_goal2'/2: Undefined procedure: room_contents/2  % elided for clarity
?- runtime_rules:room_contents(a,b).
true.

Any dynamically-created module can have its predicates exported and imported into other contexts:

% continuing the previous session
?- runtime_rules:export(room_contents/2).
true.
?- import(runtime_rules:room_contents/2).
true.
?- room_contents(a, b).
true.

While these facilities are probably not going to be used by most code, having them available when needed makes code far easier to work with. Their use, however, should be sparing given the potential for serious confusion.

Materials Not Covered

There are some facets of the module system in SWI Prolog which have not been covered by this tutorial. There are three chief reasons for these:

  • It is a particularly arcane feature beyond the scope of an introductory tutorial.

  • It is related to an older, deprecated module system.

  • It is part of a specific sub-system’s functionality and not really part of the overall module system.

Arcane feature

@/2 is a predicate used to set the calling context of a goal’s execution. It modifies the behaviour of meta-predicates and is paired, too, with the older module system. For both reasons this predicate is out of scope of this tutorial. It is assumed that if you’re ready to understand this feature that you’re beyond the need for tutorials.

Deprecated module system

Before adopting a Quintus-style module system, SWI Prolog had its own approach to modules. Indeed the current module interface is implemented in terms of the older kind. These largely deprecated predicates, which include things like the module_transparent/1 directive or the context_module/1 and strip_module/3 predicates, are out of scope for any modern code.

Specialized sub-systems

Some modules, like html_write, provide convenience directives like html_meta/1 which interact with the module system. In this specific example, for instance, html_meta/1 will invoke meta_predicate/1 appropriately while adding a layer of meaning on top. Such predicates are also out of scope of this tutorial in that they are better documented in tutorials associated with the specific sub-system involved. (Of course to understand those sub-systems you will need to know the contents of this tutorial!)

Conclusion

Modularity is the cornerstone of modern software development. Good code, in any programming language, is arranged in small collections of related data structures and functionality which are then accessed in a consistent way in other similar collections.

SWI Prolog provides tools to permit a more modern style of software development. The documentation for these tools, however, is difficult—​particularly for a newcomer—​to work through and understand.

This tutorial strived to introduce the module system as implemented by SWI Prolog both by showing a real----world module (apply.pl) and by building up a simple pair of modules to demonstrate both motivation for and implementation of the key features of the system.

Credits

I would like to thank Anne Ogborn for both the impetus (again!) to write the tutorial as well as for her valuable feedback in shaping it to something usable. Thanks are also due to Ferd Hébert, author of the wonderful book Learn You Some Erlang for Great Good!, for more editing feedback from a newcomer’s perspective. Finally I would like to thank Jan Wielemaker for SWI-Prolog and the many years of enjoyment I’ve derived from it.

Contact information

The author of this piece can be reached via email at mailto:ttmrichter@gmail.com. He frequents the ##prolog channel on the Freenode IRC service as ttmrichter.

Appendix: Source Files

add.pl
% add.pl
:- module(add, [add_all/2, add_some/3]).

add_all([H|T], S0) :-
  add_all(T, S1),
  S0 is H + S1.
add_all([], 0).

add_some(L0, G, S) :-
  filter_list(L0, G, L1),
  add_all(L1, S).

filter_list([H|T0], G, FL) :-
  ( call(G, H)
  ->  FL = [H|T1]
  ;   FL = T1),
  filter_list(T0, G, T1).
filter_list([], _, []).
filters.pl
% filters.pl
:- module(filters, [less_than_three/1]).

less_than_three(N) :-
  integer(N),
  N < 3.
broken.pl
% broken.pl
:- module(broken, []).
:- use_module(add).
:- use_module(filters).

go :-
  add_some([1,2,3,4,5], less_than_three, S),
  writeln(S).
fixedadd.pl
% fixedadd.pl
:- module(fixedadd, [add_all/2, add_some/3]).
:- meta_predicate add_some(+, 1, -).

add_all([H|T], S0) :-
  add_all(T, S1),
  S0 is H + S1.
add_all([], 0).

add_some(L0, G, S) :-
  filter_list(L0, G, L1),
  add_all(L1, S).

filter_list([H|T0], G, FL) :-
  ( call(G, H)
  ->  FL = [H|T1]
  ;   FL = T1),
  filter_list(T0, G, T1).
filter_list([], _, []).
fixed.pl
% fixed.pl
:- module(fixed, []).
:- use_module(fixedadd).
:- use_module(filters).

go :-
  add_some([1,2,3,4,5], less_than_three, S),
  writeln(S).