Experiment with a macro system inspired by KL1 language.

src/lib/goals.pl

@@ -0,0 +1,36 @@
+:- module(goals, [
+        call_unifiers/2,
+        expand_subgoals/3
+]).
+
+:- use_module(library(lists), [maplist/3,maplist/4]).
+:- use_module(library(loader), [expand_goal/3]).
+:- use_module(library(lambda)).
+
+:- meta_predicate(call_unifiers(0, ?)).
+
+%% call_unifiers(?G_0, -Us).
+%
+% `Us` is a list of unifiers that are equivalent to calling G_0.
+call_unifiers(G_0, Us) :-
+    term_variables(G_0, GVs),
+    copy_term(G_0/GVs, H_0/HVs),
+    H_0,
+    maplist(_+\A^B^(A=B)^true, GVs, HVs, Us).
+
+
+%% expand_sub_goals(?M, ?A, -X).
+%
+% Similar to expand_goal/3, but recursively tries to expand every sub-term.
+%
+% TODO: Try to make it more generic, don't rely on (#)/2.
+% FIXME: Using expand_goal/2  may be quite unpredictable, consider using something else.
+expand_subgoals(M, A, X) :-
+    nonvar(A) ->
+        (   functor(A, (#), 2) ->
+            expand_goal(A, M, X)
+        ;   A =.. [F|Args],
+            maplist(expand_subgoals(M), Args, XArgs),
+            X =.. [F|XArgs]
+        )
+    ;   A = X.

src/lib/macros.pl

@@ -0,0 +1,233 @@
+/** Macro system inspired by KL1 and PMOS from 5th Gen Computer Systems.
+
+## Quick tutorial
+
+Define your own:
+
+```
+number#one ==> 1.
+```
+
+It will replace all occurrences of `number#one` with an actual number `1`.
+
+You can have a more complex rules too:
+
+```
+math#double(X) ==> Y :- Y is 2 * X.
+```
+
+It will replace all occurrences of `math#double(...)` with computed concrete value.
+
+You can use them by simply referencing in a goal:
+
+```
+    print#S ==> format("~s", [S]).
+
+    predicate(X) :-
+        print#"STRING",
+        my_macro#atom,
+        expand#(
+            X = number#one
+        ).
+==>
+    predicate(X) :-
+        format("~s", ["STRING"]),
+        my_macro#atom,
+        X = 1.
+```
+
+Please notice that unknown macros (`my_macro`) will be left intact and you will
+observe a compilation warning.
+
+You can disable macro expansion by quoting it:
+
+```
+    predicate(X, Y) :-
+        expand#(
+            X = quote#math#double(42),
+            Y = math#double(23)
+        ).
+==>
+    predicate(X, Y) :-
+        X = quote#math#double(42),
+        Y = 46.
+````
+
+You can selectively import macros from any module that defines them:
+
+```
+:- use_module(macros_collection, [number/0, double/0]).
+```
+
+It will enable only macros that were explicitly imported, and warn if you use
+others.
+
+There is a little quirk though: if your macro has a numeric name, then it will
+be always imported. For example the following macro will always be imported if
+you import a module containing it:
+
+```
+8#String ==> Bytes :- octal_bytes(String, Bytes).
+```
+
+The only way to make it go away is to disable all macros from that module
+completely:
+
+```
+:- use_module(my_macros, []).
+```
+
+*/
+
+
+:- module(macros, [
+    op(199, xfy, (#)),
+    op(1200, xfy, (==>)),
+    expand/0,
+    inline_last/0,
+    compile/0
+]).
+
+:- use_module(library(si), [atomic_si/1,when_si/2]).
+:- use_module(library(error), [instantiation_error/1]).
+:- use_module(library(loader), [prolog_load_context/2]).
+:- use_module(library(goals), [call_unifiers/2,expand_subgoals/3]).
+:- use_module(library(warnings), [warn/2]).
+:- use_module(library(debug)).
+
+:- discontiguous(macro/3).
+:- multifile(macro/3).
+
+load_module_context(Module) :- prolog_load_context(module, Module), !.
+load_module_context(user).
+
+
+% FIXME: Rework this mess
+user:term_expansion((M#A ==> B), X) :-
+    (var(M); number(M)),
+    (   nonvar(B),
+        B = (H :- G) ->
+            X = (macros:macro(M, A, H) :- G)
+        ;   X =  macros:macro(M, A, B)
+    ).
+user:term_expansion((M#A ==> B), [Module:M,X]) :-
+    atom(M),
+    load_module_context(Module),
+    \+ catch(Module:M, error(existence_error(_,_),_), false),
+    (   nonvar(B),
+        B = (H :- G) ->
+            X = (macros:macro(M, A, H) :- G)
+        ;   X =  macros:macro(M, A, B)
+    ).
+user:term_expansion((M#A ==> B), X) :-
+    atom(M),
+    load_module_context(Module),
+    call(Module:M),
+    (   nonvar(B),
+        B = (H :- G) ->
+            X = (macros:macro(M, A, H) :- G)
+        ;   X =  macros:macro(M, A, B)
+    ).
+
+
+% All macros distribute over common operators.
+M#(A,B)  ==> M#A, M#B.
+M#(A;B)  ==> M#A; M#B.
+M#(A->B) ==> M#A -> M#B.
+M#(\+ A) ==> \+ M#A.
+M#{A}    ==> {M#A}.
+
+% Cut is never expanded.
+_#! ==> !.
+
+%% expand # ?G_0.
+%
+% Sub-goal expansion.
+%
+% Wrap any expression to recursively expand any found macros, used explicitly
+% to avoid heavy penalty of scanning all terms for possible macros:
+%
+% ```
+%     expand#(
+%         X = foo#42,
+%         bar#baz(X),
+%         \+ some#macro
+%     );
+% ```
+%
+% All following examples assume they are wrapped in `expand#(...)`.
+%
+expand#A ==> X :-
+    expand_subgoals(_, A, X).
+
+
+%% inline_last # ?G_1.
+%
+% Inline last argument at compile time.
+%
+% Useful if you want to have a formatted string as a variable:
+%
+% ```
+%     Greeting = inline_last#phrase(format_("Hello ~s~a", ["World",!])).
+% ==>
+%     Greeting = "Hello World!".
+% ```
+%
+% Perform some numeric calculations at compile time to avoid doing them in runtime:
+%
+% Two machines with with cycle time 7 and 5 need to start a task simultaneously.
+% Find the next start time:
+%
+% ```
+%     Time is inline_last#lcm(7, 5).
+% ==>
+%     Time is 35.
+% ```
+%
+% It even works with CLP(Z):
+%
+% ```
+%     #X #= inline_last#my_value * #Y.
+% ==>
+%     #X #= 2354235 * #Y.
+% ```
+%
+inline_last#G ==> [X] :-
+    load_module_context(M),
+    M:call(G, X).
+
+
+%% compile # ?G_0.
+%
+% Evaluates G and if it succeeds replaces it with a first solution represented
+% as a sequence of unifications. For example:
+%
+% ```
+%     compile#my_goal(A, B, C).
+% ==>
+%     A = 1,
+%     B = 2,
+%     C = 3.
+% ```
+%
+compile#G ==> Us :-
+    load_module_context(M),
+    call_unifiers(M:G, Us).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+macro_wrapper(quote, _, _) :- !, false.
+macro_wrapper(M, A, X) :-
+    load_module_context(Module),
+    (atom(M) -> Module:M; true),
+    macro(M, A, X).
+macro_wrapper(M, A, _) :-
+    warn("Unknown macro ~a # ~q", [M,A]),
+    throw(error(existence_error(macro/3, goal_expansion/2), [culprit-(M#A)])).
+
+user:goal_expansion(M#A, X) :-
+    atomic_si(M),
+    when_si(nonvar(A),
+        macro_wrapper(M, A, X)
+    ).

src/lib/string_macros.pl

@@ -0,0 +1,56 @@
+/** Commonly useful string macros.
+ */
+
+
+:- module(string_macros, [
+    tel/0,
+    cat/0
+]).
+
+:- use_module(library(si), [list_si/1]).
+:- use_module(library(crypto), [hex_bytes/2]).
+:- use_module(library(macros)).
+:- use_module(library(lists), [append/3]).
+
+%% 16 # +Hexes.
+%
+% Expands `Hexes` string to a list of integers (bytes).
+%
+% *TODO*: Add more base conversions
+%
+16#H ==> [B] :- list_si(H), hex_bytes(H, B).
+
+%% tel # +Mnemonic.
+%
+% Expands common ASCII characters mnemonics to actual integer value.
+%
+% *TODO*: Add enum for every common ASCII name
+%
+tel#null ==> 16#"00".
+tel#bell ==> 16#"07".
+tel#bs   ==> 16#"08".
+tel#ht   ==> 16#"09".
+tel#lf   ==> 16#"0a".
+tel#vt   ==> 16#"0b".
+tel#ff   ==> 16#"0c".
+tel#cr   ==> 16#"0d".
+
+%% cat # (+Prefix - ?Tail).
+%
+% Expands to concatenation of `Prefix` and `Tail`. `Tail` can be free variable.
+%
+% Instead of writing this:
+%
+% ```
+% Greeting = ['H',e,l,l,o,' '|Name].
+% ```
+%
+% You can write:
+%
+% ```
+% Greeting = cat#("Hello "-Name).
+% ```
+%
+% Which gives exactly the same string.
+%
+cat#(Prefix-Tail) ==> inline_last#(lists:append(Prefix, Tail)).

src/lib/warnings.pl

@@ -0,0 +1,30 @@
+:- module(warnings, [
+    warn/2,
+    warn/3
+]).
+
+:- use_module(library(format)).
+:- use_module(library(pio)).
+
+%% warn(+Format, ?Vars).
+%
+% Same as `warn/3` using default user_error stream.
+%
+warn(Format, Vars) :-
+    warn(user_error, Format, Vars).
+
+
+%% warn(+Stream, +Format, ?Vars).
+%
+% Print a warning message to Stream. Predicate is provided for uniformity of
+% warning messages throughout the codebase.
+%
+warn(Stream, Format, Vars) :-
+    prolog_load_context(file, File),
+    prolog_load_context(term_position, position_and_lines_read(_,Line)),
+    phrase_to_stream(
+        (
+            "% Warning: ", format_(Format,Vars), format_(" at line ~d of ~a~n",[Line,File])
+        ),
+        Stream
+    ).