1% * -*- Mode: Prolog -*- */
    2
    3:- module(functions,
    4          [
    5           makefile_function/3,
    6           makefile_function/4,
    7           makefile_subst_ref/3,
    8           makefile_subst_ref/4,
    9	   makefile_computed_var/3,
   10	   makefile_computed_var/4,
   11	   eval_var/2,
   12	   eval_var/3
   13           ]).   14
   15:- use_module(library(readutil)).   16
   17:- use_module(library(biomake/utils)).   18:- use_module(library(biomake/embed)).   19:- use_module(library(biomake/biomake)).   20
   21makefile_function(Result) --> makefile_function(Result,v(null,null,null,[])).
   22
   23makefile_function(Result,V) --> lb("subst"), xchr_arg(From,V), comma, xchr_arg(To,V), comma, xchr_arg(Src,V), rb, !,
   24	{ phrase(subst(From,To,Rc),Src),
   25	  string_chars(Result,Rc) }.
   26
   27makefile_function(Result,V) --> lb("patsubst"), xchr_arg(From,V), comma, xchr_arg(To,V), comma, xlst_arg(Src,V), rb, !,
   28	{ phrase(patsubst_lr(FL,FR),From),
   29	  phrase(patsubst_lr(TL,TR),To),
   30	  patsubst_all(FL,FR,TL,TR,Src,R),
   31	  concat_string_list_spaced(R,Result) }.
   32
   33makefile_function(Result,V) --> lb("strip"), xlst_arg(L,V), rb, !,
   34	{ concat_string_list_spaced(L,Result) }.
   35
   36makefile_function(Result,V) --> lb("findstring"), xstr_arg(S,V), comma, xlst_arg(L,V), rb, !,
   37	{ findstring(S,L,Result) }.
   38
   39makefile_function(Result,V) --> lb("filter"), xchr_arg(P,V), comma, xlst_arg(L,V), rb, !,
   40	{ phrase(patsubst_lr(PL,PR),P),
   41	  filter(PL,PR,L,R),
   42	  concat_string_list_spaced(R,Result) }.
   43
   44makefile_function(Result,V) --> lb("filter-out"), xchr_arg(P,V), comma, xlst_arg(L,V), rb, !,
   45	{ phrase(patsubst_lr(PL,PR),P),
   46	  filter_out(PL,PR,L,R),
   47	  concat_string_list_spaced(R,Result) }.
   48
   49makefile_function(Result,V) --> lb("sort"), xlst_arg(L,V), rb, !,
   50	{ sort(L,S),
   51	  remove_dups(S,R),
   52	  concat_string_list_spaced(R,Result) }.
   53
   54makefile_function(Result,V) --> lb("word"), xnum_arg(N,V), comma, xlst_arg(L,V), rb, !,
   55	{ nth_element(N,L,Result) }.
   56
   57makefile_function(Result,V) --> lb("wordlist"), xnum_arg(S,V), comma, xnum_arg(E,V), comma, xlst_arg(L,V), rb, !,
   58	{ slice(S,E,L,Sliced),
   59	  concat_string_list(Sliced,Result," ") }.
   60
   61makefile_function(Result,V) --> lb("words"), xlst_arg(L,V), rb, !,
   62	{ length(L,Result) }.
   63
   64makefile_function(Result,V) --> lb("firstword"), xlst_arg([Result|_],V), rb, !.
   65
   66makefile_function(Result,V) --> lb("lastword"), xlst_arg(L,V), rb, !,
   67	{ last_element(L,Result) }.
   68
   69makefile_function(Result,V) --> lb("dir"), xlst_arg(Paths,V), rb, !,
   70	{ maplist(file_directory_slash,Paths,R),
   71	  concat_string_list_spaced(R,Result) }.
   72
   73makefile_function(Result,V) --> lb("notdir"), xlst_arg(Paths,V), rb, !,
   74	{ maplist(file_base_name,Paths,R),
   75	  concat_string_list_spaced(R,Result) }.
   76
   77makefile_function(Result,V) --> lb("basename"), xlst_arg(Paths,V), rb, !,
   78	{ maplist(basename,Paths,R),
   79	  concat_string_list_spaced(R,Result) }.
   80
   81makefile_function(Result,V) --> lb("suffix"), xlst_arg(Paths,V), rb, !,
   82	{ maplist(suffix,Paths,R),
   83	  concat_string_list_spaced(R,Result) }.
   84
   85makefile_function(Result,V) --> lb("addsuffix"), xstr_arg(Suffix,V), comma, xlst_arg(Prefixes,V), rb, !,
   86	{ addsuffix(Suffix,Prefixes,R),
   87	  concat_string_list_spaced(R,Result) }.
   88
   89makefile_function(Result,V) --> lb("addprefix"), xstr_arg(Prefix,V), comma, xlst_arg(Suffixes,V), rb, !,
   90	{ addprefix(Prefix,Suffixes,R),
   91	  concat_string_list_spaced(R,Result) }.
   92
   93makefile_function(Result,V) --> lb("join"), xlst_arg(Prefixes,V), comma, xlst_arg(Suffixes,V), rb, !,
   94	{ maplist(string_concat,Prefixes,Suffixes,R),
   95	  concat_string_list_spaced(R,Result) }.
   96
   97makefile_function(Result,V) --> lb("wildcard"), xstr_arg(W,V), rb, !,
   98	{ expand_file_name(W,Rx),
   99	  include(exists_file,Rx,R),
  100	  concat_string_list_spaced(R,Result) }.
  101
  102makefile_function(Result,V) --> lb("abspath"), xstr_arg(Path,V), rb, !,
  103        { absolute_file_name(Path,Result); Result = "" }.
  104
  105makefile_function(Result,V) --> lb("realpath"), xstr_arg(Path,V), rb, !,
  106        { (absolute_file_name(Path,Result), (exists_file(Result); exists_directory(Result))); Result = "" }.
  107
  108makefile_function(Result,V) --> lb("call"), xvar_arg(UserFunc,V), opt_whitespace, call_param_list(L,V), rb, !,
  109        { V = v(V1,V2,V3,BLold),
  110	  call_bindings(L,1,BLnew),
  111	  append(BLold,BLnew,BL),
  112	  eval_var(UserFunc,Result,v(V1,V2,V3,BL)) }.
  113
  114makefile_function(Result,V) --> lb("shell"), xstr_arg(Exec,V), rb, !,
  115	{ shell_eval_str(Exec,Result) }.
  116
  117makefile_function(Result,V) --> lb("foreach"), var_arg(Var), opt_whitespace, comma, xlst_arg(List,V), comma, str_arg(Text), rb, !,
  118	{ makefile_foreach(Var,List,Text,R,V),
  119	  concat_string_list_spaced(R,Result) }.
  120
  121makefile_function(Result,V) --> lb("if"), xstr_arg(Condition,V), opt_whitespace, comma, str_arg(Then), comma, str_arg(Else), rb, !,
  122        { (Condition = ''; Condition = "") -> expand_vars(Else,Result,V); expand_vars(Then,Result,V) }.
  123
  124makefile_function(Result,V) --> lb("if"), xstr_arg(Condition,V), opt_whitespace, comma, str_arg(Then), rb, !,
  125        { (Condition = ''; Condition = "") -> Result = ""; expand_vars(Then,Result,V) }.
  126
  127makefile_function(Result,V) --> lb("or"), opt_whitespace, cond_param_list(L), rb, !,
  128        { makefile_or(L,Result,V) }.
  129
  130makefile_function(Result,V) --> lb("and"), opt_whitespace, cond_param_list(L), rb, !,
  131        { makefile_and(L,Result,V) }.
  132
  133makefile_function(Result,_V) --> lb("value"), opt_whitespace, var_arg(Var), rb,
  134        { atom_string(VarAtom,Var), global_binding(VarAtom,Result) }, !.
  135
  136makefile_function(Result,V) --> lb("value"), opt_whitespace, var_arg(Var), rb, !,
  137        { bindvar(Var,V,Result) }.
  138
  139makefile_function(Result,V) --> lb("iota"), opt_whitespace, xnum_arg(N,V), rb, !,
  140	{ iota(N,L),
  141 	  concat_string_list_spaced(L,Result) }.
  142
  143makefile_function(Result,V) --> lb("iota"), opt_whitespace, xnum_arg(S,V), comma, opt_whitespace, xnum_arg(E,V), rb, !,
  144	{ iota(S,E,L),
  145	  concat_string_list_spaced(L,Result) }.
  146
  147makefile_function(Result,V) --> lb("add"), opt_whitespace, xstr_arg(Na,V), comma, opt_whitespace, xlst_arg(List,V), rb, !,
  148        { maplist(add(Na),List,ResultList),
  149	  concat_string_list_spaced(ResultList,Result) }.
  150
  151makefile_function(Result,V) --> lb("multiply"), opt_whitespace, xstr_arg(Na,V), comma, opt_whitespace, xlst_arg(List,V), rb, !,
  152        { maplist(multiply(Na),List,ResultList),
  153	  concat_string_list_spaced(ResultList,Result) }.
  154
  155makefile_function(Result,V) --> lb("divide"), opt_whitespace, xstr_arg(Na,V), comma, opt_whitespace, xlst_arg(List,V), rb, !,
  156        { maplist(divide(Na),List,ResultList),
  157	  concat_string_list_spaced(ResultList,Result) }.
  158
  159makefile_function(Result,V) --> lb("bagof"), xstr_arg(Template,V), comma, xstr_arg(Goal,V), rb, !,
  160	{ eval_bagof(Template,Goal,Result) }.
  161
  162makefile_function("",_V) --> ['('], str_arg(S), [')'], !, {format("Warning: unknown function $(~w)~n",[S])}.
  163
  164makefile_subst_ref(Result) --> makefile_subst_ref(Result,v(null,null,null,[])).
  165
  166makefile_subst_ref(Result,V) --> ['('], xvar_arg(Var,V), [':'], suffix_arg(From), ['='], suffix_arg(To), [')'], !,
  167	{ eval_var(Var,Val,V),
  168	  split_spaces(Val,L),
  169	  maplist(substref(From,To),L,Lsub),
  170	  concat_string_list_spaced(Lsub,Result) }.
  171
  172substref(From,To,Orig,Result) :-
  173	  string_chars(Orig,C),
  174	  phrase(patsubst_lr(FL,FR),['%'|From]),
  175	  phrase(patsubst_lr(TL,TR),['%'|To]),
  176	  patsubst(FL,FR,TL,TR,C,Rc),
  177	  string_chars(Result,Rc).
  178
  179makefile_computed_var(Result) --> makefile_computed_var(Result,v(null,null,null,[])).
  180
  181makefile_computed_var(Result,V) --> ['('], xvar_arg(Var,V), [')'], !,
  182	{ eval_var(Var,Result,V) }.
  183
  184lb(Func) --> ['('], {string_chars(Func,Cs)}, opt_whitespace, Cs, [' '], !.
  185rb --> opt_whitespace, [')'].
  186
  187comma --> opt_whitespace, [','].
  188xlst_arg(L,V) --> xstr_arg(S,V), !, {split_spaces(S,L)}.
  189xchr_arg(C,V) --> xstr_arg(S,V), !, {string_chars(S,C)}.
  190xnum_arg(N,V) --> xstr_arg(S,V), !, {atom_number(S,N)}.
  191xstr_arg(Sx,V) --> str_arg(S), !, {expand_vars(S,Sx,V)}.
  192chr_arg(C) --> str_arg(S), !, {string_chars(S,C)}.
  193str_arg(S) --> opt_whitespace, str_arg_outer(S).
  194str_arg_outer(S) --> ['('], !, str_arg_inner(Si), [')'], str_arg_outer(Rest), {concat_string_list(["(",Si,")",Rest],S)}.
  195str_arg_outer(S) --> string_from_chars(Start,"(),"), !, str_arg_outer(Rest), {string_concat(Start,Rest,S)}.
  196str_arg_outer("") --> !.
  197str_arg_inner(S) --> ['('], !, str_arg_inner(Si), [')'], str_arg_inner(Rest), {concat_string_list(["(",Si,")",Rest],S)}.
  198str_arg_inner(S) --> string_from_chars(Start,"()"), !, str_arg_inner(Rest), {string_concat(Start,Rest,S)}.
  199str_arg_inner("") --> !.
  200
  201xvar_arg(S,_V) --> var_arg(S).
  202xvar_arg(S,V) --> ['$','('], !, xstr_arg(X,V), [')'], {eval_var(X,S,V)}.
  203
  204var_arg(S) --> opt_whitespace, makefile_var_string_from_chars(S).
  205
  206suffix_arg(C) --> char_list(C,['=',')',' ']).
  207
  208var_expr(VarName,Expr) :-
  209	concat_string_list(["$(",VarName,")"],Expr).
  210
  211eval_var(VarName,Val) :-
  212	var_expr(VarName,Expr),
  213	expand_vars(Expr,Val).
  214
  215eval_var(VarName,Val,V) :-
  216	var_expr(VarName,Expr),
  217	expand_vars(Expr,Val,V).
  218
  219call_param_list([],_V) --> [].
  220call_param_list([P|Ps],V) --> comma, !, xstr_arg(P,V), call_param_list(Ps,V).
  221
  222call_bindings([],_,[]).
  223call_bindings([Param|Params],Num,[NumAtom=Param|Vars]) :-
  224	atom_number(NumAtom,Num),
  225	NextNum is Num + 1,
  226	call_bindings(Params,NextNum,Vars).
  227
  228makefile_foreach(_,[],_,[],_).
  229makefile_foreach(Var,[L|Ls],Text,[R|Rs],V) :-
  230    atom_string(VarAtom,Var),
  231    V = v(V1,V2,V3,BLold),
  232    append(BLold,[VarAtom=L],BL),
  233    expand_vars(Text,R,v(V1,V2,V3,BL)),
  234    makefile_foreach(Var,Ls,Text,Rs,V).
  235
  236cond_param_list([P|Ps]) --> str_arg(P), comma, !, cond_param_list(Ps).
  237cond_param_list([P]) --> str_arg(P), !.
  238
  239makefile_or([],'',_) :- !.
  240makefile_or([C|_],Result,V) :- expand_vars(C,Result,V), Result \= "", Result \= '', !.
  241makefile_or([_|Cs],Result,V) :- makefile_or(Cs,Result,V).
  242
  243makefile_and([C],Result,V) :- expand_vars(C,Result,V), !.
  244makefile_and([C|Cs],Result,V) :- expand_vars(C,X,V), X \= "", X \= '', !, makefile_and(Cs,Result,V).
  245makefile_and(_,'',_).
  246
  247subst(Cs,Ds,Result) --> Cs, !, subst(Cs,Ds,Rest), {append(Ds,Rest,Result)}.
  248subst(Cs,Ds,[C|Rest]) --> [C], !, subst(Cs,Ds,Rest).
  249subst(_Cs,_Ds,[]) --> !.
  250
  251patsubst_all(_,_,_,_,[],[]).
  252patsubst_all(FL,FR,TL,TR,[Src|Srest],[Dest|Drest]) :-
  253	string_chars(Src,Sc),
  254	patsubst(FL,FR,TL,TR,Sc,Dc),
  255	string_chars(Dest,Dc),
  256	!,
  257	patsubst_all(FL,FR,TL,TR,Srest,Drest).
  258
  259patsubst(FL,FR,TL,TR,S,D) :-
  260	phrase(patsubst_match(FL,FR,Match),S),
  261	append(TL,Match,DL),
  262	append(DL,TR,D).
  263patsubst(_,_,_,_,S,S).
  264
  265patsubst_lr([],[]) --> [].
  266patsubst_lr([C|L],R) --> [C], {C\='%'}, !, patsubst_lr(L,R).
  267patsubst_lr([],R) --> ['%'], patsubst_lr_r(R).
  268patsubst_lr_r([]) --> [].
  269patsubst_lr_r([C|R]) --> [C], !, patsubst_lr_r(R).
  270
  271patsubst_match(L,R,Match) --> L, patsubst_match_m(R,Match).
  272patsubst_match_m(R,[C|Match]) --> [C], patsubst_match_m(R,Match).
  273patsubst_match_m(R,[]) --> R.
  274
  275findstring(S,[L|_],S) :- string_codes(S,Sc), string_codes(L,Lc), Sc = Lc, !.  % this seems a bit contrived, but a straight test for string equality doesn't seem to work
  276findstring(S,[_|L],R) :- findstring(S,L,R).
  277findstring(_,[],"").
  278
  279filter(_,_,[],[]).
  280filter(L,R,[Src|Srest],[Src|Drest]) :-
  281	string_chars(Src,Sc),
  282	phrase(patsubst_match(L,R,_),Sc),
  283	!,
  284	filter(L,R,Srest,Drest).
  285filter(L,R,[_|Srest],Dest) :- filter(L,R,Srest,Dest).
  286
  287filter_out(_,_,[],[]).
  288filter_out(L,R,[Src|Srest],Dest) :-
  289	string_chars(Src,Sc),
  290	phrase(patsubst_match(L,R,_),Sc),
  291	!,
  292	filter_out(L,R,Srest,Dest).
  293filter_out(L,R,[Src|Srest],[Src|Drest]) :- filter_out(L,R,Srest,Drest).
  294
  295% remove_dups assumes list is sorted
  296remove_dups([],[]).
  297remove_dups([X,X|Xs],Y) :- !, remove_dups([X|Xs],Y).
  298remove_dups([X|Xs],[X|Ys]) :- remove_dups(Xs,Ys).
  299
  300basename_suffix(B,S) --> string_from_chars(B," "), ['.'], string_from_chars(Srest," ."), {string_concat(".",Srest,S)}, !.
  301basename_suffix("",S) --> ['.'], string_from_chars(Srest," ."), {string_concat(".",Srest,S)}, !.
  302basename_suffix(B,"") --> string_from_chars(B," .").
  303
  304basename(P,B) :- string_chars(P,Pc), phrase(basename_suffix(B,_),Pc).
  305suffix(P,S) :- string_chars(P,Pc), phrase(basename_suffix(_,S),Pc).
  306
  307addsuffix(_,[],[]).
  308addsuffix(S,[N|Ns],[R|Rs]) :- string_concat(N,S,R), addsuffix(S,Ns,Rs).
  309
  310addprefix(_,[],[]).
  311addprefix(P,[N|Ns],[R|Rs]) :- string_concat(P,N,R), addprefix(P,Ns,Rs).
  312
  313iota(N,L) :- iota(1,N,L).
  314iota(S,E,[]) :- S > E, !.
  315iota(S,E,[S|L]) :- Snext is S + 1, iota(Snext,E,L).
  316
  317% these arithmetic functions are highly idiosyncratic to this module - do not re-use!
  318multiply(Aa,Bs,C) :- atom_string(Aa,As), number_string(A,As), number_string(B,Bs), C is A * B.
  319divide(Aa,Bs,C) :- atom_string(Aa,As), number_string(A,As), number_string(B,Bs), C is B / A.
  320add(Aa,Bs,C) :- atom_string(Aa,As), number_string(A,As), number_string(B,Bs), C is A + B