1:- module(func, [ op(675, xfy, ($)) 2 , op(650, xfy, (of)) 3 , ($)/2 4 , (of)/2 5 ]). 6:- use_module(library(list_util), [xfy_list/3]). 7:- use_module(library(function_expansion)). 8:- use_module(library(arithmetic)). 9:- use_module(library(error)). 10 11 12% true if the module whose terms are being read has specifically 13% imported library(func). 14wants_func :- 15 prolog_load_context(module, Module), 16 Module \== func, % we don't want func sugar ourselves 17 predicate_property(Module:of(_,_),imported_from(func)).
nonvar.
For example, to treat library(assoc) terms as functions which map a key to a value, one might define:
:- multifile compile_function/4.
compile_function(Assoc, Key, Value, Goal) :-
is_assoc(Assoc),
Goal = get_assoc(Key, Assoc, Value).
Then one could write:
list_to_assoc([a-1, b-2, c-3], Assoc), Two = Assoc $ b,
42:- multifile compile_function/4. 43compile_function(Var, _, _, _) :- 44 % variables storing functions must be evaluated at run time 45 % and can't be compiled, a priori, into a goal 46 var(Var), 47 !, 48 fail. 49compile_function(Expr, In, Out, Out is Expr) :- 50 % arithmetic expression of one variable are simply evaluated 51 \+ string(Expr), % evaluable/1 throws exception with strings 52 arithmetic:evaluable(Expr), 53 term_variables(Expr, [In]). 54compile_function(F, In, Out, func:Goal) :- 55 % composed functions 56 function_composition_term(F), 57 user:function_expansion(F, func:Functor, true), 58 Goal =.. [Functor,In,Out]. 59compile_function(F, In, Out, Goal) :- 60 % string interpolation via format templates 61 format_template(F), 62 ( atom(F) -> 63 Goal = format(atom(Out), F, In) 64 ; string(F) -> 65 Goal = format(string(Out), F, In) 66 ; error:has_type(codes, F) -> 67 Goal = format(codes(Out), F, In) 68 ; fail % to be explicit 69 ). 70compile_function(Dict, In, Out, Goal) :- 71 current_predicate(system:is_dict/1), 72 is_dict(Dict), 73 Goal = get_dict(In, Dict, Out).
This is realized by expanding function application to chained predicate calls at compile time. Function application itself can be chained.
Reversed = reverse $ sort $ [c,d,b].
88:- meta_predicate $(,). 89$(_,_) :- 90 throw(error(permission_error(call, predicate, ($)/2), 91 context(_, '$/2 must be subject to goal expansion'))). 92 93userfunction_expansion($(F,X), Y, Goal) :- 94 wants_func, 95 ( func:compile_function(F, X, Y, Goal) -> 96 true 97 ; var(F) -> Goal = % defer until run time 98 ( func:compile_function(F, X, Y, P) -> 99 call(P) 100 ; call(F, X, Y) 101 ) 102 ; Goal = call(F, X, Y) 103 ).
Reversed = reverse of sort $ [c,d,b].
116:- meta_predicate of(,). 117of(_,_).
124format_template(Format) :- 125 atom(Format), !, 126 atom_codes(Format, Codes), 127 format_template(Codes). 128format_template(Format) :- 129 string(Format), 130 !, 131 string_codes(Format, Codes), 132 format_template(Codes). 133format_template(Format) :- 134 error:has_type(codes, Format), 135 memberchk(0'~, Format). % ' fix syntax highlighting 136 137 138% True if the argument is a function composition term 139function_composition_term(of(_,_)). 140 141% Converts a function composition term into a list of functions to compose 142functions_to_compose(Term, Funcs) :- 143 functor(Term, Op, 2), 144 Op = (of), 145 xfy_list(Op, Term, Funcs). 146 147% Thread a state variable through a list of functions. This is similar 148% to a DCG expansion, but much simpler. 149thread_state([], [], Out, Out). 150thread_state([F|Funcs], [Goal|Goals], In, Out) :- 151 ( compile_function(F, In, Tmp, Goal) -> 152 true 153 ; var(F) -> 154 instantiation_error(F) 155 ; F =.. [Functor|Args], 156 append(Args, [In, Tmp], NewArgs), 157 Goal =.. [Functor|NewArgs] 158 ), 159 thread_state(Funcs, Goals, Tmp, Out). 160 161userfunction_expansion(Term, M:Functor, true) :- 162 wants_func, 163 functions_to_compose(Term, Funcs), 164 debug(func, 'building composed function for: ~w', [Term]), 165 variant_sha1(Funcs, Sha), 166 format(atom(Functor), 'composed_function_~w', [Sha]), 167 debug(func, ' name: ~s', [Functor]), 168 ( func:current_predicate(Functor/2) -> 169 debug(func, ' composed predicate already exists', []) 170 ; true -> 171 reverse(Funcs, RevFuncs), 172 thread_state(RevFuncs, Threaded, In, Out), 173 xfy_list(',', Body, Threaded), 174 Head =.. [Functor, In, Out], 175 prolog_load_context(module, M), 176 M:assert(Head :- Body), 177 M:compile_predicates([Functor/2]) 178 ). 179 180 181% support foo(x,~,y) evaluation 182userfunction_expansion(MTerm, Output, MGoal) :- 183 ( MTerm=_:Term -> true; Term=MTerm ), 184 wants_func, 185 compound(Term), 186 187 % has a single ~ argument 188 setof( X 189 , ( arg(X,Term,Arg), Arg == '~' ) 190 , [N] 191 ), 192 193 % replace ~ with a variable 194 Term =.. [Name|Args0], 195 nth1(N, Args0, ~, Rest), 196 nth1(N, Args, Output, Rest), 197 Goal =.. [Name|Args], 198 ( MTerm=Mod:_ -> MGoal=Mod:Goal; MGoal=Goal )