Introduction
Dogelog Player is a 100% Prolog written Prolog system for the JavaScript, Python and Java platform. From its inception we let most of the higher order logic programming rest in limbo. Only recently we added call/n and maplist/n, foldl/n, etc..
The upcoming release will see the introduction of arrow functions via (=>)/2 and filter/3, etc.. JavaScript programmers might be familiar with the concept, only our arrow functions are boolean arrow functions driven by the outcome of a goal.
Arrow Syntax
Our choice of (=>)/2 as the Prolog operator for arrow functions exactly matches the operator as found in JavaScript. It came by accident since we wanted to implement the Lambda expressions library(yall) from Logtalk, as adopted by SWI-Prolog. The library(yall) uses the Prolog operator (>>)/2:
/* SWI-Prolog */
?- maplist([X,Y]>>(Y is X+1), [1,2,3], L).
L = [2, 3, 4].
Unfortuately it was not possibly for us to define clauses for (>>)/n, since it is an evaluable function and Dogelog Player has only a combined namespace for predicates and evaluable functions. So we opted for op(700, xfy, =>), with the benefit that less parenthesis are needed to express an arrow function:
/* Dogelog Player */
?- maplist((X,Y) => Y is X+1, [1,2,3], L).
L = [2, 3, 4].
While library(yall) requires to wrap the formal parmeters into a Prolog list. Another syntactic change in Dogelog Player is to use the Prolog operator (,)/2 to construct the formal parameter list, again exactly matching the JavaScript syntax. The special case of a single parameter reads in library(yall):
/* SWI-Prolog */
?- include([X]>>(X > 3), [7,3,5,1,10], L).
L = [7, 5, 10].
While in Dogelog Player this special case even needs no parenthesis at all:
/* Dogelog Player */
?- filter(X => X > 3, [7,3,5,1,10], L).
L = [7, 5, 10].
Arrow Semantic
We tryed to match the library(yall) semantic as close as possible. In particular library(yall) supports so called currying. Lets have a look at a predicate defined closure such as minus/3. Under the hood execution of predicates such as maplist/n, foldl/n, etc.. is covered by call/n:
minus(X, Y, Z) :- Z is X-Y.
?- maplist(minus, [7,3,5], [1,10,0], L).
L = [6, -7, 5].
call/n made it into the ISO core Prolog standard, and there is not much room left for design choices. On the otherhand the ISO core Prolog standard has no coverage of Lambda expressions. One choice is to support currying, which means that closures can be abstracted into closures:
/* SWI-Prolog */
?- maplist([X,Y]>>minus(Y,X), [7,3,5], [1,10,0], L).
L = [-6, 7, -5].
/* Dogelog Player */
?- maplist((X,Y) => minus(Y,X), [7,3,5], [1,10,0], L).
L = [-6, 7, -5].
Concerning non-argument parameters, that is variables in the body but not in the parameter list, we decided to follow the implicit approach of formerly Jekejeke Prolog and not the explict approach of library(yall). The below example illutrates that in library(yall) we have to opt-in non-argument parameters:
/* SWI-Prolog */
?- maplist({D}/[X,Y]>>(Y = [X|D]), [7,3,5], L).
L = [[7|D], [3|D], [5|D]].
/* Dogelog Player */
?- maplist((X,Y) => Y = [X|D], [7,3,5], L).
L = [[7|D], [3|D], [5|D]].
Arrow Preprocessing
By adopting the approach of formerly Jekejeke Prolog we made the execution more expensive. Without ahead of time compilation of arrow functions, the Prolog interpreter not only needs a copy_term/2 but also a free_variables/3 determination to dynamically execute arrow functions (=>)/2:
=>(X, Y, Z) :-
free_variables(X^Y, L, H),
'$LAM'(X, L, H, Z).
'$LAM'(X, L, H, Z) :-
copy_term(v(X,H,L),v(Z,G,L)),
G.
We can nevertheless do something for the higher order predicates such as maplist/n, foldl/n, etc.. that perform loops. We already had in place a lower level predicate ir_pred_site/2 that made a closure cachable, avoiding repeated predicate lookup. As a next step we preprocess free_variables/3:
ir_arrow_site((X => Y), Z) :- !,
free_variables(X^Y, L, H),
ir_pred_site('$LAM'(X, L, H), Z).
ir_arrow_site(X, Y) :-
ir_pred_site(X, Y).
This new utility replaces all our former use of ir_pred_site/2. The below code shows the typical use case of ir_arrow_site/2 for higher order predicates such as amaplist/n, foldl/n, etc.. It demonstrates a new predicate filter/3 that made it into our library(sets). Before entering the loop the closure is transformed:
filter(C, L, R) :-
ir_arrow_site(C, D),
sys_filter(L, D, R).
The loop itself is designed for first argument indexing:
sys_filter([], _, []).
sys_filter([X|L], C, [X|R]) :-
call(C, X), !,
sys_filter(L, C, R).
sys_filter([_|L], C, R) :-
sys_filter(L, C, R).
Future Outlook
Among functional programming languages the filter functional is not the only prominent specimen that deals with lists in a higher order fashion. One finds in the wild functionals such as takeWhile, partition, span, etc.. that could be easily added to the stock of a Prolog system that has call/n.
The filter/3 can be used to bootstrap intersect/2 and subtract/3:
intersect(A, B, C) :-
filter(X => member(X,B), A, C).
subtract(A, B, C) :-
filter(X => \+ member(X,B), A, C).
This made us abandon the classical content of library(sets) with intersect/2, subtract/3, etc.. and only offer the higher order predicate filter/3. The solution is not yet optimal, since the execution still runs one free_variables/3 call and many copy_term/2 calls, having O(N) complexity for the list argument B.
To reduce the runtime complexity one could deploy ahead of time compilation as found in library(apply_macros) from SWI-Prolog, and that were then extended to library(yall). The future prospect for Dogelog Player would be to utilize our Albufeira anonymous predicates, as already used for if-then-else inlining.
Conclusions
Diverting from library(yall) of Logtalk provenance, the syntax and semantic of our arrow functions matches that of JavaScript. To speed up loop processing we have already a runtime preprocessing in place. The future might bring refinements, such as ahead of time compilation into Albufeira anonymous predicates.