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
15:- nodebug(makefile). 16
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
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
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
--> comment.
529opt_comment --> opt_space, "\n", [].
--> opt_space, "#", ignore_line.
531ignore_line --> ("\n" ; call(eos)), !.
532ignore_line --> [_], ignore_line.
533ignore_line --> [].
534
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)