1% * -*- Mode: Prolog -*- */
    2
    3:- module(gnumake_parser,
    4          [
    5              parse_gnu_makefile/4,
    6	      eval_gnu_makefile/4
    7	  ]).    8
    9:- use_module(library(pio)).   10:- use_module(library(biomake/utils)).   11:- use_module(library(biomake/functions)).   12:- use_module(library(biomake/biomake)).   13
   14% Declare all debug topics defined in this module
   15:- nodebug(makefile).   16
   17% Wrapper for reading GNU Makefile
   18parse_gnu_makefile(F,M,OptsOut,OptsIn) :-
   19    parse_gnu_makefile('',F,M,OptsOut,OptsIn).
   20
   21parse_gnu_makefile(DirSlash,F,M,OptsOut,OptsIn) :-
   22    debug(makefile,'reading: ~w',[F]),
   23
   24    atom_string(MAKEFILE_LIST,"MAKEFILE_LIST"),
   25    MakefileListAssignment = assignment(MAKEFILE_LIST,"+=",F),
   26    add_gnumake_clause(MakefileListAssignment,OptsIn,OptsIn),
   27
   28    (bagof(G,member(toplevel(G),OptsIn),MakeCmdGoals)
   29     ; MakeCmdGoals = []),
   30    atomic_list_concat(MakeCmdGoals,' ',MakeCmdGoalStr),
   31    atom_string(MAKECMDGOALS,"MAKECMDGOALS"),
   32    MakeCmdGoalsAssignment = assignment(MAKECMDGOALS,"=",MakeCmdGoalStr),
   33    add_gnumake_clause(MakeCmdGoalsAssignment,OptsIn,OptsIn),
   34
   35    format(string(Path),"~w~w",[DirSlash,F]),
   36    phrase_from_file(makefile_rules(Mf,OptsOut,OptsIn,1,Path),Path),
   37    M = [MakefileListAssignment,MakeCmdGoalsAssignment|Mf],
   38    debug(makefile,"rules: ~w~noptions: ~w",[M,OptsOut]).
   39
   40eval_gnu_makefile(Text,M,OptsOut,OptsIn) :-
   41    debug(makefile,'evaluating: ~w',[Text]),
   42    string_codes(Text,Codes),
   43    phrase(makefile_rules(M,OptsOut,OptsIn,1,"(eval)"),Codes),
   44    debug(makefile,"rules: ~w~noptions: ~w",[M,OptsOut]).
   45
   46% Grammar for reading GNU Makefile
   47makefile_rules([],Opts,Opts,_,_) --> call(eos), !.
   48makefile_rules(Rules,OptsOut,OptsIn,Line,File) -->
   49	makefile_block(BlockRules,BlockOptsOut,OptsIn,Line,File,BlockLines),
   50	!, { Lnext is Line + BlockLines, append(BlockRules,NextRules,Rules)},
   51	makefile_rules(NextRules,OptsOut,BlockOptsOut,Lnext,File).
   52
   53eos([], []).
   54
   55makefile_block([],Opts,Opts,_,_,1) --> comment, !.
   56makefile_block([],Opts,Opts,_,_,1) --> blank_line, !.
   57makefile_block([],Opts,Opts,_,_,Lines) --> info_line(Lines), !.
   58makefile_block([],Opts,Opts,Line,File,Lines) --> warning_line(Line,File,Lines), !.
   59makefile_block([],Opts,Opts,Line,File,_) --> error_line(Line,File), !.
   60makefile_block(Rules,OptsOut,OptsIn,Line,File,Lines) --> prolog_block(true,Rules,OptsOut,OptsIn,Line,File,Lines).
   61makefile_block(Rules,OptsOut,OptsIn,Line,File,Lines) --> makefile_conditional(true,Rules,OptsOut,OptsIn,Line,File,Lines), !.
   62makefile_block(Rules,OptsOut,OptsIn,_,File,1) --> include_line(true,File,Rules,OptsOut,OptsIn), !.
   63makefile_block([Assignment],Opts,Opts,_,_,Lines) --> makefile_assignment(Assignment,Lines), !,
   64	{add_gnumake_clause(Assignment,Opts,Opts)}.
   65makefile_block([export(Var)],Opts,Opts,_,_,Lines) --> makefile_export(Var,Lines),
   66	{add_gnumake_clause(export(Var),Opts,Opts)}.
   67makefile_block([Assignment,export(Var)],Opts,Opts,_,_,Lines) --> makefile_export_assignment(Assignment,Lines),
   68        {Assignment = assignment(Var,_,_),
   69	 add_gnumake_clause(Assignment,Opts,Opts),
   70	 add_gnumake_clause(export(Var),Opts,Opts)}.
   71makefile_block([option(Opt)],[Opt|Opts],Opts,_,_,Lines) --> makefile_special_target(Opt,Lines), !.
   72makefile_block([Rule],Opts,Opts,_,_,Lines) --> makefile_recipe(Rule,Lines), !,
   73	{add_gnumake_clause(Rule,Opts,Opts)}.
   74makefile_block(_,_,_,Line,File,_) -->
   75	opt_space, "\t", !,
   76	{format(string(Err),"GNU makefile parse error at line ~d of file ~w: unexpected tab character",[Line,File]),
   77	syntax_error(Err)}.
   78makefile_block(_,_,_,Line,File,_) -->
   79	line_as_string(L), !,
   80	{format(string(Err),"GNU makefile parse error at line ~d of file ~w: ~w",[Line,File,L]),
   81	syntax_error(Err)}.
   82
   83ignore_makefile_block(Opts,Opts,Line,File,Lines) --> prolog_block(false,_,_,Opts,Line,File,Lines).
   84ignore_makefile_block(Opts,Line,File,Lines) --> makefile_conditional(false,_,_,Opts,Line,File,Lines), !.
   85ignore_makefile_block(Opts,_,_,1) --> include_line(false,null,_,Opts,Opts), !.
   86ignore_makefile_block(_Opts,_,_,Lines) --> makefile_assignment(_,Lines), !.
   87ignore_makefile_block(_Opts,_,_,Lines) --> makefile_special_target(_,Lines), !.
   88ignore_makefile_block(_Opts,_,_,Lines) --> makefile_recipe(_,Lines), !.
   89ignore_makefile_block(Opts,Line,File,Lines) --> makefile_block([],Opts,Opts,Line,File,Lines).
   90
   91prolog_block(Active,Rules,OptsOut,OptsIn,Line,File,Lines) -->
   92    opt_space,
   93    "prolog",
   94    opt_period,
   95    opt_whitespace,
   96    "\n",
   97    { Lnext is Line + 1 },
   98    prolog_block_body(RawLines,Lnext,File,Lbody),
   99    { Lines is Lbody + 1,
  100      read_prolog_from_string(Active,Rules,OptsOut,OptsIn,RawLines) },
  101    !.
  102
  103prolog_block_body(_,_,File,_) -->
  104    call(eos),
  105    { format(string(Err),"GNU makefile parse error (expected endprolog) at end of file ~w",[File]),
  106      syntax_error(Err) }.
  107
  108prolog_block_body([],_,_,1) -->
  109    opt_space,
  110    "endprolog",
  111    opt_period,
  112    opt_whitespace,
  113    "\n",
  114    !.
  115
  116prolog_block_body([RawLine|RawLines],Line,File,Lines) -->
  117    line_as_string(RawLine,1),
  118    { Lnext is Line + 1 },
  119    prolog_block_body(RawLines,Lnext,File,Lbody),
  120    { Lines is Lbody + 1 },
  121    !.
  122
  123opt_period --> ".".
  124opt_period --> [].
  125
  126read_prolog_from_string(false,[],Opts,Opts,_).
  127read_prolog_from_string(true,Rules,OptsOut,OptsIn,RawLines) :-
  128    concat_string_list(RawLines,Raw,"\n"),
  129    open_string(Raw,IOS),
  130    read_makeprog_stream(IOS,OptsOut,OptsIn,Terms),
  131    maplist(wrap_prolog,Terms,Rules).
  132
  133wrap_prolog(Term,prolog(Term)).
  134
  135error_line(Line,File) -->
  136    opt_space,
  137    "$(error",
  138    whitespace,
  139    makefile_warning_text(W,_),
  140    ")",
  141    opt_whitespace,
  142    "\n",
  143    !,
  144    {format(string(Warning),"~w:~w: ~w~n",[File,Line,W]),
  145     write(user_error,Warning),
  146     throw(Warning)}.
  147
  148warning_line(Line,File,Lines) -->
  149    opt_space,
  150    "$(warning",
  151    whitespace,
  152    makefile_warning_text(W,NL),
  153    ")",
  154    opt_whitespace,
  155    "\n",
  156    !,
  157    {format(string(Warning),"~w:~w: ~w~n",[File,Line,W]),
  158     write(user_error,Warning),
  159     Lines is NL + 1}.
  160
  161info_line(Lines) -->
  162    opt_space,
  163    "$(info",
  164    whitespace,
  165    makefile_warning_text(W,NL),
  166    ")",
  167    opt_whitespace,
  168    "\n",
  169    !,
  170    {format("~w~n",[W]),
  171     Lines is NL + 1}.
  172
  173include_line(Active,CurrentFile,Rules,OptsOut,OptsIn) -->
  174    opt_space,
  175    "include",
  176    whitespace,
  177    include_makefiles(Active,CurrentFile,Rules,OptsOut,OptsIn).
  178
  179include_makefiles(Active,CurrentFile,Rules,OptsOut,OptsIn) -->
  180	makefile_filename_string(F), opt_whitespace, "\n", !,
  181	{Active -> include_gnu_makefile(F,CurrentFile,Rules,OptsOut,OptsIn) ; true}.
  182include_makefiles(Active,CurrentFile,Rules,OptsOut,OptsIn) -->
  183	makefile_filename_string(F), whitespace, !,
  184	{Active -> include_gnu_makefile(F,CurrentFile,R,Opts,OptsIn) ; true},
  185	include_makefiles(Next,CurrentFile,OptsOut,Opts),
  186	{append(R,Next,Rules)}.
  187
  188include_gnu_makefile(F,CurrentFile,R,Opts,OptsIn) :-
  189        expand_vars(F,XF),
  190	(bagof(Dslash,
  191	       (member(include_dir(D),OptsIn),
  192	        format(atom(Dslash),"~w/",[D])),
  193	       RevDirs)
  194	 ; RevDirs = []),
  195	reverse(RevDirs,Dirs),
  196	file_directory_name(CurrentFile,CurrentFileDir),
  197	format(atom(CurrentFileDirSlash),"~w/",[CurrentFileDir]),
  198	search_include_dirs(XF,CurrentFile,['','./',CurrentFileDirSlash|Dirs],R,Opts,OptsIn).
  199
  200search_include_dirs(F,CurrentFile,[],_,_,_) :-
  201	format(string(Err),"Couldn't find makefile ~w included from ~w",[F,CurrentFile]),
  202	throw(Err).
  203search_include_dirs(F,_,[Dir|_],R,Opts,OptsIn) :-
  204	format(string(Path),"~w/~w",[Dir,F]),
  205	exists_file(Path),
  206	!,
  207	parse_gnu_makefile(Dir,F,R,Opts,OptsIn).
  208search_include_dirs(F,CurrentFile,[_|Dirs],R,Opts,OptsIn) :-
  209	search_include_dirs(F,CurrentFile,Dirs,R,Opts,OptsIn).
  210
  211makefile_assignment(assignment(Var,Op,Val),Lines) -->
  212    opt_space,
  213    "define",
  214    whitespace,
  215    makefile_var_atom_from_codes(Var),
  216    opt_whitespace,
  217    op_string(Op),
  218    opt_whitespace,
  219    "\n",
  220    makefile_def_body(Cs,BodyLines),
  221    {string_codes(Val,Cs),
  222     Lines is BodyLines + 1}.
  223
  224makefile_assignment(assignment(Var,"=",Val),Lines) -->
  225    opt_space,
  226    "define",
  227    whitespace,
  228    makefile_var_atom_from_codes(Var),
  229    opt_whitespace,
  230    "\n",
  231    makefile_def_body(Cs,BodyLines),
  232    {string_codes(Val,Cs),
  233     Lines is BodyLines + 1}.
  234
  235makefile_assignment(assignment(Var,Op,Val),Lines) -->
  236    opt_space,
  237    makefile_var_atom_from_codes(Var),
  238    opt_whitespace,
  239    op_string(Op),
  240    opt_whitespace,
  241    line_as_string(Val,Lines).
  242
  243makefile_export(Var,1) -->
  244    opt_space,
  245    "export",
  246    whitespace,
  247    makefile_var_atom_from_codes(Var),
  248    opt_whitespace,
  249    "\n".
  250
  251makefile_export_assignment(Assignment,Lines) -->
  252    opt_space,
  253    "export",
  254    whitespace,
  255    makefile_assignment(Assignment,Lines).
  256
  257makefile_conditional(Active,Result,OptsOut,OptsIn,Line,File,Lines) -->
  258    opt_space, "ifeq", whitespace, conditional_arg_pair(Active,Arg1,Arg2), opt_whitespace, "\n",
  259    !, {test_equal(Active,Arg1,Arg2,Condition)},
  260    begin_true_rules(Condition,Result,OptsOut,OptsIn,Line,File,Lines).
  261
  262makefile_conditional(Active,Result,OptsOut,OptsIn,Line,File,Lines) -->
  263    opt_space, "ifneq", whitespace, conditional_arg_pair(Active,Arg1,Arg2), opt_whitespace, "\n",
  264    !, {test_inequal(Active,Arg1,Arg2,Condition)},
  265    begin_true_rules(Condition,Result,OptsOut,OptsIn,Line,File,Lines).
  266
  267makefile_conditional(Active,Result,OptsOut,OptsIn,Line,File,Lines) -->
  268    opt_space, "ifdef", whitespace, axvar(Active,Arg),
  269    !, {test_inequal(Active,Arg,'',Condition)},
  270    begin_true_rules(Condition,Result,OptsOut,OptsIn,Line,File,Lines).
  271
  272makefile_conditional(Active,Result,OptsOut,OptsIn,Line,File,Lines) -->
  273    opt_space, "ifndef", whitespace, axvar(Active,Arg),
  274    !, {test_equal(Active,Arg,'',Condition)},
  275    begin_true_rules(Condition,Result,OptsOut,OptsIn,Line,File,Lines).
  276
  277test_equal(false,_,_,null).
  278test_equal(true,X,X,true) :- !.
  279test_equal(true,_,_,false).
  280
  281test_inequal(false,_,_,null).
  282test_inequal(true,X,X,false) :- !.
  283test_inequal(true,_,_,true).
  284
  285conditional_arg_pair(true,Arg1,Arg2) --> "(", xbracket(Arg1), ",",  opt_whitespace, xbracket(Arg2), ")".
  286conditional_arg_pair(true,Arg1,Arg2) --> "'", xquote(Arg1), "'", whitespace, "'", xquote(Arg2), "'".
  287conditional_arg_pair(true,Arg1,Arg2) --> "\"", xdblquote(Arg1), "\"", whitespace, "\"", xdblquote(Arg2), "\"".
  288conditional_arg_pair(false,_,_) --> "(", null_bracket, ",",  opt_whitespace, null_bracket, ")".
  289conditional_arg_pair(false,_,_) --> "'", null_quote, "'", whitespace, "'", null_quote, "'".
  290conditional_arg_pair(false,_,_) --> "\"", null_dblquote, "\"", whitespace, "\"", null_dblquote, "\"".
  291
  292begin_true_rules(Condition,Rules,OptsOut,OptsIn,Line,File,Lines) -->
  293    { Lnext is Line + 1 },
  294    true_rules(Condition,Rules,OptsOut,OptsIn,Lnext,File,Ltf),
  295    { Lines is Ltf + 1 }.
  296
  297true_rules(_,[],OptsIn,OptsIn,_,_,1) -->
  298    opt_space, "endif", !, opt_whitespace, "\n".
  299
  300true_rules(Condition,Rules,OptsOut,OptsIn,Line,File,Lines) -->
  301    opt_space, "else", !, opt_whitespace, "\n",
  302    { Lnext is Line + 1 },
  303    false_rules(Condition,Rules,OptsOut,OptsIn,Lnext,File,FalseLines),
  304    { Lines is FalseLines + 1}.
  305
  306true_rules(true,Rules,OptsOut,OptsIn,Line,File,Lines) -->
  307    makefile_block(BlockRules,BlockOptsOut,OptsIn,Line,File,BlockLines),
  308    !, { Lnext is Line + BlockLines, append(BlockRules,NextRules,Rules) },
  309    true_rules(true,NextRules,OptsOut,BlockOptsOut,Lnext,File,NextLines),
  310    { Lines is BlockLines + NextLines }.
  311
  312true_rules(Condition,Rules,OptsOut,OptsIn,Line,File,Lines) -->
  313    { Condition \= true },
  314    ignore_makefile_block(OptsIn,Line,File,BlockLines),
  315    !, { Lnext is Line + BlockLines },
  316    true_rules(Condition,Rules,OptsOut,OptsIn,Lnext,File,NextLines),
  317    { Lines is BlockLines + NextLines }.
  318
  319true_rules(_,_,_,_,Line,File,_) -->
  320    line_as_string(L), !,
  321    {format(string(Err),"GNU makefile parse error (expected else/endif) at line ~d of file ~w: ~w",[Line,File,L]),
  322    syntax_error(Err)}.
  323
  324false_rules(_,[],OptsIn,OptsIn,_,_,1) -->
  325    opt_space, "endif", !, opt_whitespace, "\n".
  326
  327false_rules(false,Rules,OptsOut,OptsIn,Line,File,Lines) -->
  328    makefile_block(BlockRules,BlockOptsOut,OptsIn,Line,File,BlockLines),
  329    !, { Lnext is Line + BlockLines, append(BlockRules,NextRules,Rules) },
  330    false_rules(false,NextRules,OptsOut,BlockOptsOut,Lnext,File,NextLines),
  331    { Lines is BlockLines + NextLines }.
  332
  333false_rules(Condition,[],OptsIn,OptsIn,Line,File,Lines) -->
  334    { Condition \= false },
  335    ignore_makefile_block(OptsIn,Line,File,BlockLines),
  336    !, { Lnext is Line + BlockLines },
  337    false_rules(Condition,[],OptsIn,OptsIn,Lnext,File,NextLines),
  338    { Lines is BlockLines + NextLines }.
  339
  340false_rules(_,_,_,_,Line,File,_) -->
  341    line_as_string(L), !,
  342    {format(string(Err),"GNU makefile parse error (expected endif) at line ~d of file ~w: ~w",[Line,File,L]),
  343    syntax_error(Err)}.
  344
  345xbracket(Sx) --> xdelim(Sx,[[0'(,0')],[0'{,0'}]],[0'),0',],[0'\\,0'\n],0).
  346null_bracket --> delim(_,[[0'(,0')],[0'{,0'}]],[0'),0',],[0'\\,0'\n],0).
  347
  348xbrace(Sx,NL) --> xdelim(Sx,[[0'{,0'}]],[0'}],[],NL).
  349xdelim(Sx,LR,XO,XI,NL) --> delim(S,LR,XO,XI,NL), !, {expand_vars(S,Sx)}.
  350delim(S,LR,X,XA,NL) --> {bagof(L,member([L,_],LR),XL), append(XL,XA,XI), append(X,XI,XO)}, delim_codes(Sc,LR,XO,XI,NL), {string_codes(S,Sc)}.
  351
  352% delim_codes(-S,+LR,+XO,+XI,-NL)
  353% general parser
  354% S = list of character codes
  355% LR = list of pairs of delimiter character codes [Left,Right]
  356% XO = list of character codes that are to be excluded in the outermost context
  357% XI = list of character codes that are to be excluded in the innermost context
  358% NL = number of lines matched
  359delim_codes([0'\s|S],LR,XO,XI,NL) --> [0'\\,0'\n], !, delim_codes(S,LR,XO,XI,NLnext), {NL is NLnext + 1}.
  360delim_codes([0'\n|S],LR,XO,XI,NL) --> {NL \= 0}, [0'\n], !, delim_codes(S,LR,XO,XI,NLnext), {NL is NLnext + 1}.
  361delim_codes(S,LR,XO,XI,NL) --> {member([L,R],LR)}, [L], !, delim_codes(I,LR,[R|XI],XI,NLi), [R], delim_codes(Rest,LR,XO,XI,NLo),
  362       { append([L|I],[R],LIR), append(LIR,Rest,S), NL is NLi + NLo }.
  363delim_codes([C|Cs],LR,XO,XI,NL) --> [0'\\,C], {member(C,XO)}, !, delim_codes(Cs,LR,XO,XI,NL).
  364delim_codes([C|Cs],LR,XO,XI,NL) --> [C], {\+ member(C,XO)}, !, delim_codes(Cs,LR,XO,XI,NL).
  365delim_codes([],_,_,_,0) --> !.
  366
  367xquote(Sx) --> code_list(C,[0'\']), {string_codes(S,C), expand_vars(S,Sx)}.
  368null_quote --> code_list(_,[0'\']).
  369xdblquote(Sx) --> code_list(C,[0'\"]), {string_codes(S,C), expand_vars(S,Sx)}.
  370null_dblquote --> code_list(_,[0'\"]).
  371xvar(Sx) --> makefile_var_string_from_codes(S), opt_whitespace, "\n", {eval_var(S,Sx)}.
  372
  373axvar(true,Sx) --> xvar(Sx).
  374axvar(false,_) --> makefile_var_string_from_codes(_), opt_whitespace, "\n".
  375
  376makefile_special_target(delete_on_error(true),Lines) -->
  377    makefile_recipe(rule([".DELETE_ON_ERROR"],_,_),Lines).
  378
  379makefile_special_target(queue(none),Lines) -->
  380    makefile_recipe(rule([".NOTPARALLEL"],_,_),Lines).
  381
  382makefile_special_target(oneshell(true),Lines) -->
  383    makefile_recipe(rule([".ONESHELL"],_,_),Lines).
  384
  385makefile_special_target(phony_targets(TL),Lines) -->
  386    makefile_special_deplist(".PHONY",TL,Lines).
  387
  388makefile_special_target(silent_targets(TL),Lines) -->
  389    makefile_special_deplist(".SILENT",TL,Lines).
  390
  391makefile_special_target(Opt,Lines) -->
  392    makefile_special_deplist(".IGNORE",TL,Lines),
  393    { TL = []
  394      -> Opt = keep_going_on_error(true)
  395      ; Opt = ignore_errors_in_targets(TL) }.
  396
  397makefile_special_deplist(SpecialTarget,DepList,Lines) -->
  398    makefile_recipe(rule([SpecialTarget],DL,_),Lines),
  399    {maplist(expand_vars,DL,XDL1),
  400     maplist(split_spaces,XDL1,XDL2),
  401     flatten_trim(XDL2,DepList)}.
  402
  403makefile_recipe(rule(Head,Deps,Exec,{HeadGoal},{DepGoal},VNs),Lines) -->
  404    makefile_targets(Head),
  405    whitespace_or_linebreak,
  406    "{",
  407    xbrace(HeadGoalAtom,Lhead),
  408    "}",
  409    opt_whitespace,
  410    ":",
  411    opt_makefile_deps(Deps),
  412    whitespace_or_linebreak,
  413    "{",
  414    xbrace(DepGoalAtom,Ldep),
  415    "}",
  416    opt_comment,
  417    !,
  418    makefile_execs(Exec,Lexecs),
  419    { Lines is 1 + Lexecs + Lhead + Ldep,
  420      read_atom_as_makeprog_term(HeadGoalAtom,HeadGoal,HeadVNs),
  421      read_atom_as_makeprog_term(DepGoalAtom,DepGoal,DepVNs),
  422      merge_unifications(HeadVNs,DepVNs,VNs) }.
  423
  424makefile_recipe(rule(Head,Deps,Exec,{HeadGoal},{true},VNs),Lines) -->
  425    makefile_targets(Head),
  426    whitespace_or_linebreak,
  427    "{",
  428    xbrace(HeadGoalAtom,Lhead),
  429    "}",
  430    opt_whitespace,
  431    ":",
  432    opt_makefile_deps(Deps),
  433    opt_comment,
  434    !,
  435    makefile_execs(Exec,Lexecs),
  436    { Lines is 1 + Lexecs + Lhead,
  437      read_atom_as_makeprog_term(HeadGoalAtom,HeadGoal,VNs) }.
  438
  439makefile_recipe(rule(Head,Deps,Exec,{DepGoal},VNs),Lines) -->
  440    makefile_targets(Head),
  441    ":",
  442    opt_makefile_deps(Deps),
  443    whitespace_or_linebreak,
  444    "{",
  445    xbrace(DepGoalAtom,Ldep),
  446    "}",
  447    opt_comment,
  448    !,
  449    makefile_execs(Exec,Lexecs),
  450    { Lines is 1 + Lexecs + Ldep,
  451      read_atom_as_makeprog_term(DepGoalAtom,DepGoal,VNs) }.
  452
  453makefile_recipe(rule(Head,Deps,Exec),Lines) -->
  454    makefile_targets(Head),
  455    ":",
  456    opt_makefile_deps(Deps),
  457    opt_comment,
  458    !,
  459    makefile_execs(Exec,Lexecs),
  460    {Lines is 1 + Lexecs}.
  461
  462makefile_recipe(rule(Head,Deps,[Efirst|Erest]),Lines) -->
  463    makefile_targets(Head),
  464    ":",
  465    opt_makefile_deps(Deps),
  466    ";",
  467    opt_space,
  468    exec_line_as_string(Efirst,Lfirst),
  469    !,
  470    makefile_execs(Erest,Lexecs),
  471    {Lines is Lfirst + Lexecs}.
  472
  473opt_makefile_deps(T) --> opt_whitespace, makefile_targets(T).
  474opt_makefile_deps([]) --> opt_whitespace.
  475
  476makefile_targets([T|Ts]) --> opt_space, makefile_target_string(T), whitespace, makefile_targets(Ts), opt_whitespace.
  477makefile_targets([T]) --> opt_space, makefile_target_string(T), opt_whitespace.
  478
  479whitespace_or_linebreak --> "\n", opt_whitespace.
  480whitespace_or_linebreak --> whitespace.
  481
  482opt_linebreak --> [].
  483opt_linebreak --> "\n", opt_whitespace.
  484
  485makefile_warning_text(S,NL) --> delim(S,[[0'(,0')]],[0')],[0'\\],NL).
  486makefile_filename_string(S) --> string_from_codes(S," \t\n").
  487
  488makefile_target_string(S) --> makefile_target_codes(Sc,null), {Sc \= [], string_codes(S,Sc)}.
  489makefile_target_codes(S,Rterm) --> [0'$,0'(], !, makefile_target_codes(Sv,0')), [0')], makefile_target_codes(St,Rterm), {append([0'$,0'(|Sv],[0')|St],S)}, !.
  490makefile_target_codes(S,Rterm) --> [0'$,0'{], !, makefile_target_codes(Sv,0'}), [0'}], makefile_target_codes(St,Rterm), {append([0'$,0'{|Sv],[0'}|St],S)}, !.
  491makefile_target_codes([C|St],Rterm) --> [0'$], makefile_var_char(C), !, makefile_target_codes(St,Rterm), !.
  492makefile_target_codes([C|St],Rterm) --> [C], {Rterm \= null, \+ member(C,[Rterm,0'\n])}, !, makefile_target_codes(St,Rterm).
  493makefile_target_codes([C|St],null) --> [C], {\+ member(C,[0'#,0':,0';,0'\s,0'\t,0'\n,0'\\])}, !, makefile_target_codes(St,null).
  494makefile_target_codes([],_) --> [].
  495
  496op_string("=") --> "=".
  497op_string(":=") --> ":=".
  498op_string("::=") --> ":=".
  499op_string("?=") --> "?=".
  500op_string("+=") --> "+=".
  501op_string("!=") --> "!=".
  502
  503makefile_execs([E|Es],Lines) --> makefile_exec(E,L), !, {Lines = Lrest + L}, makefile_execs(Es,Lrest).
  504makefile_execs(Es,Lines) --> comment, !, {Lines = Lrest + 1}, makefile_execs(Es,Lrest).
  505makefile_execs([],0) --> !.
  506
  507makefile_exec(E,L) --> "\t", !, exec_line_as_string(E,L).
  508
  509exec_line([],0) --> call(eos), !.
  510exec_line([0'\\,0'\n|Cs],Lplus1) --> "\\\n\t", !, exec_line(Cs,L), {Lplus1 is L + 1}.
  511exec_line([0'\\,0'\n|Cs],Lplus1) --> "\\\n", !, exec_line(Cs,L), {Lplus1 is L + 1}.
  512exec_line([],1) --> "\n", !.
  513exec_line([C|Cs],L) --> [C], exec_line(Cs,L).
  514exec_line_as_string(S,L) --> exec_line(C,L), {string_codes(S,C)}.
  515
  516line([],0) --> call(eos), !.
  517line([0'\s|Cs],Lplus1) --> "\\\n", !, line(Cs,L), {Lplus1 is L + 1}.
  518line([],1) --> "\n", !.
  519line([],1) --> comment.
  520line([C|Cs],L) --> [C], line(Cs,L).
  521line_as_string(S,L) --> line(C,L), {string_codes(S,C)}.
  522line_as_string(S) --> line_as_string(S,_).
  523
  524makefile_def_body([],1) --> opt_space, "endef", !, opt_whitespace, "\n".
  525makefile_def_body(['\n'|Cs],Lplus1) --> ['\n'], !, makefile_def_body(Cs,L), {Lplus1 is L + 1}.
  526makefile_def_body([C|Cs],Lines) --> [C], makefile_def_body(Cs,Lines).
  527
  528opt_comment --> comment.
  529opt_comment --> opt_space, "\n", [].
  530comment --> opt_space, "#", ignore_line.
  531ignore_line --> ("\n" ; call(eos)), !.
  532ignore_line --> [_], ignore_line.
  533ignore_line --> [].
  534
  535% due to @triska
  536merge_unifications(Us1, Us2, Us) :-
  537        append(Us1, Us2, Us3),
  538        maplist(eq_pair, Us3, Pairs0),
  539        keysort(Pairs0, Pairs),
  540        group_pairs_by_key(Pairs, Groups),
  541        maplist(vars_all_equal, Groups, Us).
  542
  543eq_pair(A=B, A-B).
  544
  545vars_all_equal(Label-[Var|Vars], Label=Var) :-
  546        maplist(=(Var), Vars)