diff --git a/src/lib/goals.pl b/src/lib/goals.pl new file mode 100644 index 000000000..2bf6695a1 --- /dev/null +++ b/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. diff --git a/src/lib/macros.pl b/src/lib/macros.pl new file mode 100644 index 000000000..4575f6227 --- /dev/null +++ b/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) + ). diff --git a/src/lib/string_macros.pl b/src/lib/string_macros.pl new file mode 100644 index 000000000..47fcf5c87 --- /dev/null +++ b/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)). diff --git a/src/lib/warnings.pl b/src/lib/warnings.pl new file mode 100644 index 000000000..dc9e5f3fd --- /dev/null +++ b/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 + ). diff --git a/src/tests/macros.pl b/src/tests/macros.pl new file mode 100644 index 000000000..a0bea490d --- /dev/null +++ b/src/tests/macros.pl @@ -0,0 +1,113 @@ +:- use_module(library(format)). +:- use_module(library(dcgs)). +:- use_module(library(lambda)). + +:- use_module(library(string_macros), [tel/0,cat/0]). % <- Macros can be imported selectively +:- use_module(library(macros)). +:- use_module(library(clpz)). + +% Numeric enums +fep#window ==> 100. + fep#create ==> 101. + fep#create_with_buffer ==> 102. + fep#get_max_size ==> 103. + fep#getl ==> 110. + fep#putb ==> 111. + fep#flush ==> 112. + fep#beep ==> 113. + +%% Conditional compilation +string_num. +bignum#(A < B) ==> N :- + string_num -> N = bignum_lt(A,B); N = (A < B). +bignum#(A > B) ==> N :- + \+string_num -> N = (A > B); N = bignum_gt(A,B). + +%% Should bad macro bodies generate exceptions? If so at which point: expansion +%% time, compile time or runtime? +%bad#macro ==> 1 :- _. +% +%% TODO: Should implementation detect discontinuous macro definitions? +%fep#too_late ==> 999. +% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +% Test functions +double(A, B) :- B is 2 * A. +baz(A, B, C, D) :- B is 2 * A, C is 3 * A, D is 3 * B. + + +:- dynamic(example/1). + +example(formated_string(X)) :- + expand#( + X = inline_last#(\L^phrase(format_("This is my term ~w", [foo(1)]), L)) + ). +example(bignum_example(A,B,P)) :- + bignum#( + A < B, + !, + A > 0; + B + 1 < P + ), + compute(A,B). +example(numeric_enum_example) :- + expand#( + foo(fep#window, fep#create), + bar([fep#getl, fep#putb|_]) + ). +%example(ascii_examples) :- +% expand#( +% foo(tel#null) -> foo(tel#bell); foo(tel#bs) +% ). +%example(base_conversion) :- +% expand#( +% foo(16#"ABCDEF01234560") +% ). +%example(quotated_goals_are_not_expanded(A)) :- +% quote#(bignum#(A<2)). +%example(quotation_works_in_nested_terms(A)) :- +% expand#( +% A = [fep#putb,_,quote#fep#putb] +% ). +%example(expands_arithmetic_functions(A,B)) :- +% expand#( +% B is A + fep#beep / inline_last#double(12) +% ). +%example(doesnt_expand_uninstantiated_macros(X)) :- +% expand#( +% _ = fep#X +% ). +%example(compilation([A,B,C])) :- +% compile#baz(12, A, B, C). +%% What is the preferred operator precedence? Should parenthesis be required here? +%example(modules(L)) :- +% compile#(lists:length(L, 5)). +%example(clpz_operators_compatibility(X,Y)) :- +% expand#( +% #X #= #Y * inline_last#double(4) +% ). +%example(concatenation(Name)) :- +% expand#write(cat#("Hello "-Name)). +%example(unknown_macros) :- +% fep#hello, +% foo#bar, +% foo#fep#window. % <- Should it expand fep#window if foo is unknown? +%example(incorrect_macros) :- +% b(a)#x, % <- Is it a good idea to support any ground term as a macro name? +% b(_)#x, +% _#t, +% fep#_. +%example(tbd) :- +% a(b#c)#d, % <- Should it expand b#c? If b/0 and a/1 are registered macros? +% a#b#c#d. % <- In which order macros should be expanded? +% +%% Should macros be expanded in clauses heads? +%example(macro_in_heads(16#"ABCD")). +% +%% Should it be possible to rename predicate name using macros? +%(my_macro#example(macro_names)) :- +% write('Hello'), nl. +% +%% Should it be possible to expand whole clauses in-place? +%my_macro#(my_example(X) :- hello(X)). diff --git a/tests/scryer/cli/src_tests/macros_tests.stderr b/tests/scryer/cli/src_tests/macros_tests.stderr new file mode 100644 index 000000000..e69de29bb diff --git a/tests/scryer/cli/src_tests/macros_tests.stdout b/tests/scryer/cli/src_tests/macros_tests.stdout new file mode 100644 index 000000000..0074f726e --- /dev/null +++ b/tests/scryer/cli/src_tests/macros_tests.stdout @@ -0,0 +1,12 @@ +example(formated_string(A)) :- + A="This is my term foo(1)". +example(bignum_example(A,B,C)) :- + ( bignum_lt(A,B), + !, + bignum_gt(A,0) + ; bignum_lt(B+1,C) + ), + compute(A,B). +example(numeric_enum_example) :- + foo(100,101), + bar([110,111|A]). diff --git a/tests/scryer/cli/src_tests/macros_tests.toml b/tests/scryer/cli/src_tests/macros_tests.toml new file mode 100644 index 000000000..b5f9b1dcc --- /dev/null +++ b/tests/scryer/cli/src_tests/macros_tests.toml @@ -0,0 +1,7 @@ +args = [ + "-f", + "--no-add-history", + "-g", "listing(example/1)", + "-g", "halt", + "src/tests/macros.pl" +]