1/* valamethodcall.vala
2 *
3 * Copyright (C) 2006-2012  Jürg Billeter
4 *
5 * This library is free software; you can redistribute it and/or
6 * modify it under the terms of the GNU Lesser General Public
7 * License as published by the Free Software Foundation; either
8 * version 2.1 of the License, or (at your option) any later version.
9
10 * This library is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
13 * Lesser General Public License for more details.
14
15 * You should have received a copy of the GNU Lesser General Public
16 * License along with this library; if not, write to the Free Software
17 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301  USA
18 *
19 * Author:
20 * 	Jürg Billeter <j@bitron.ch>
21 */
22
23using GLib;
24
25/**
26 * Represents an invocation expression in the source code.
27 */
28public class Vala.MethodCall : Expression {
29	/**
30	 * The method to call.
31	 */
32	public Expression call {
33		get { return _call; }
34		set {
35			_call = value;
36			_call.parent_node = this;
37		}
38	}
39
40	public bool is_yield_expression { get; set; }
41
42	public bool is_assert { get; private set; }
43
44	/**
45	 * Whether this chain up uses the constructv function with va_list.
46	 */
47	public bool is_constructv_chainup { get; private set; }
48
49	public bool is_chainup { get; private set; }
50
51	private Expression _call;
52
53	private List<Expression> argument_list = new ArrayList<Expression> ();
54
55	/**
56	 * Creates a new invocation expression.
57	 *
58	 * @param call             method to call
59	 * @param source_reference reference to source code
60	 * @return                 newly created invocation expression
61	 */
62	public MethodCall (Expression call, SourceReference? source_reference = null) {
63		this.source_reference = source_reference;
64		this.call = call;
65	}
66
67	/**
68	 * Appends the specified expression to the list of arguments.
69	 *
70	 * @param arg an argument
71	 */
72	public void add_argument (Expression arg) {
73		argument_list.add (arg);
74		arg.parent_node = this;
75	}
76
77	/**
78	 * Returns the argument list.
79	 *
80	 * @return argument list
81	 */
82	public unowned List<Expression> get_argument_list () {
83		return argument_list;
84	}
85
86	public override void accept (CodeVisitor visitor) {
87		visitor.visit_method_call (this);
88
89		visitor.visit_expression (this);
90	}
91
92	public override void accept_children (CodeVisitor visitor) {
93		call.accept (visitor);
94
95		foreach (Expression expr in argument_list) {
96			expr.accept (visitor);
97		}
98	}
99
100	public override void replace_expression (Expression old_node, Expression new_node) {
101		if (call == old_node) {
102			call = new_node;
103		}
104
105		int index = argument_list.index_of (old_node);
106		if (index >= 0) {
107			argument_list[index] = new_node;
108			new_node.parent_node = this;
109		}
110	}
111
112	public override bool is_constant () {
113		unowned MethodType? method_type = call.value_type as MethodType;
114
115		if (method_type != null) {
116			// N_ and NC_ do not have any effect on the C code,
117			// they are only interpreted by xgettext
118			// this means that it is ok to use them in constant initializers
119			if (method_type.method_symbol.get_full_name () == "GLib.N_") {
120				// first argument is string
121				return argument_list[0].is_constant ();
122			} else if (method_type.method_symbol.get_full_name () == "GLib.NC_") {
123				// first and second argument is string
124				return argument_list[0].is_constant () && argument_list[1].is_constant ();
125			}
126		}
127
128		return false;
129	}
130
131	public override bool is_pure () {
132		return false;
133	}
134
135	public override bool is_accessible (Symbol sym) {
136		foreach (var arg in argument_list) {
137			if (!arg.is_accessible (sym)) {
138				return false;
139			}
140		}
141
142		return call.is_accessible (sym);
143	}
144
145	public override void get_error_types (Collection<DataType> collection, SourceReference? source_reference = null) {
146		if (source_reference == null) {
147			source_reference = this.source_reference;
148		}
149		unowned DataType? mtype = call.value_type;
150		if (mtype is MethodType) {
151			unowned Method m = ((MethodType) mtype).method_symbol;
152			if (!(m.coroutine && !is_yield_expression && ((MemberAccess) call).member_name != "end")) {
153				m.get_error_types (collection, source_reference);
154			}
155		} else if (mtype is ObjectType) {
156			// constructor
157			unowned Class cl = (Class) ((ObjectType) mtype).type_symbol;
158			unowned Method m = cl.default_construction_method;
159			m.get_error_types (collection, source_reference);
160		} else if (mtype is DelegateType) {
161			unowned Delegate d = ((DelegateType) mtype).delegate_symbol;
162			d.get_error_types (collection, source_reference);
163		}
164
165		foreach (Expression expr in argument_list) {
166			expr.get_error_types (collection, source_reference);
167		}
168	}
169
170	public override bool check (CodeContext context) {
171		if (checked) {
172			return !error;
173		}
174
175		checked = true;
176
177		if (!call.check (context)) {
178			/* if method resolving didn't succeed, skip this check */
179			error = true;
180			return false;
181		}
182
183		// type of target object
184		DataType target_object_type = null;
185
186		List<DataType> method_type_args = null;
187
188		if (call.value_type is DelegateType) {
189			// delegate invocation, resolve generic types relative to delegate
190			target_object_type = call.value_type;
191		} else if (call is MemberAccess) {
192			unowned MemberAccess ma = (MemberAccess) call;
193			if (ma.prototype_access) {
194				error = true;
195				Report.error (source_reference, "Access to instance member `%s' denied".printf (call.symbol_reference.get_full_name ()));
196				return false;
197			}
198
199			method_type_args = ma.get_type_arguments ();
200
201			if (ma.inner != null) {
202				target_object_type = ma.inner.value_type;
203
204				// foo is relevant instance in foo.bar.connect (on_bar)
205				if (ma.inner.symbol_reference is Signal) {
206					unowned MemberAccess? sig = ma.inner as MemberAccess;
207					if (sig != null) {
208						target_object_type = sig.inner.value_type;
209					}
210				}
211
212				// foo is relevant instance in foo.bar.begin (bar_ready) and foo.bar.end (result)
213				unowned Method? m = ma.symbol_reference as Method;
214				if (m != null && m.coroutine) {
215					// begin or end call of async method
216					if (ma.member_name == "begin" || ma.member_name == "end") {
217						unowned MemberAccess? method_access = ma.inner as MemberAccess;
218						if (method_access != null && method_access.inner != null) {
219							target_object_type = method_access.inner.value_type;
220						} else {
221							// static method
222							target_object_type = null;
223						}
224					}
225				}
226			}
227
228			if (ma.symbol_reference != null && ma.symbol_reference.get_attribute ("Assert") != null) {
229				this.is_assert = true;
230
231				if (argument_list.size == 1) {
232					this.source_reference = argument_list[0].source_reference;
233				}
234			}
235		}
236
237		var mtype = call.value_type;
238		var gobject_chainup = (context.profile == Profile.GOBJECT && call.symbol_reference == context.analyzer.object_type);
239		is_chainup = gobject_chainup;
240
241		if (!gobject_chainup) {
242			unowned Expression expr = call;
243			unowned MemberAccess? ma = expr as MemberAccess;
244			if (ma != null && ma.symbol_reference is CreationMethod) {
245				expr = ma.inner;
246				ma = expr as MemberAccess;
247			}
248			if (ma != null && ma.member_name == "this") {
249				// this[.with_foo] ()
250				is_chainup = true;
251			} else if (expr is BaseAccess) {
252				// base[.with_foo] ()
253				is_chainup = true;
254			}
255		}
256
257		unowned CreationMethod? base_cm = null;
258
259		if (is_chainup) {
260			unowned CreationMethod? cm = context.analyzer.find_current_method () as CreationMethod;
261			if (cm == null) {
262				error = true;
263				Report.error (source_reference, "invocation not supported in this context");
264				return false;
265			} else if (cm.chain_up) {
266				error = true;
267				Report.error (source_reference, "Multiple constructor calls in the same constructor are not permitted");
268				return false;
269			}
270			cm.chain_up = true;
271
272			if (mtype is ObjectType) {
273				unowned Class cl = (Class) ((ObjectType) mtype).type_symbol;
274				base_cm = cl.default_construction_method;
275				if (base_cm == null) {
276					error = true;
277					Report.error (source_reference, "chain up to `%s' not supported".printf (cl.get_full_name ()));
278					return false;
279				} else if (!base_cm.has_construct_function) {
280					error = true;
281					Report.error (source_reference, "chain up to `%s' not supported".printf (base_cm.get_full_name ()));
282					return false;
283				}
284			} else if (call.symbol_reference is CreationMethod && call.symbol_reference.parent_symbol is Class) {
285				base_cm = (CreationMethod) call.symbol_reference;
286				if (!base_cm.has_construct_function) {
287					error = true;
288					Report.error (source_reference, "chain up to `%s' not supported".printf (base_cm.get_full_name ()));
289					return false;
290				}
291			} else if (gobject_chainup) {
292				unowned Class? cl = cm.parent_symbol as Class;
293				if (cl == null || !cl.is_subtype_of (context.analyzer.object_type)) {
294					error = true;
295					Report.error (source_reference, "chain up to `GLib.Object' not supported");
296					return false;
297				}
298				call.value_type = new ObjectType (context.analyzer.object_type);
299				mtype = call.value_type;
300			}
301		}
302
303		// check for struct construction
304		if (call is MemberAccess &&
305		    ((call.symbol_reference is CreationMethod
306		      && call.symbol_reference.parent_symbol is Struct)
307		     || call.symbol_reference is Struct)) {
308			unowned Struct? st = call.symbol_reference as Struct;
309			if (st != null && st.default_construction_method == null && (st.is_boolean_type () || st.is_integer_type () || st.is_floating_type ())) {
310				error = true;
311				Report.error (source_reference, "invocation not supported in this context");
312				return false;
313			}
314
315			var struct_creation_expression = new ObjectCreationExpression ((MemberAccess) call, source_reference);
316			struct_creation_expression.struct_creation = true;
317			foreach (Expression arg in argument_list) {
318				struct_creation_expression.add_argument (arg);
319			}
320			struct_creation_expression.target_type = target_type;
321			context.analyzer.replaced_nodes.add (this);
322			parent_node.replace_expression (this, struct_creation_expression);
323			struct_creation_expression.check (context);
324			return true;
325		} else if (!is_chainup && call is MemberAccess && call.symbol_reference is CreationMethod) {
326			error = true;
327			Report.error (source_reference, "use `new' operator to create new objects");
328			return false;
329		}
330
331		if (!is_chainup && mtype is ObjectType) {
332			// prevent funny stuff like (new Object ()) ()
333			error = true;
334			Report.error (source_reference, "invocation not supported in this context");
335			return false;
336		} else if (mtype != null && mtype.is_invokable ()) {
337			// call ok, expression is invokable
338		} else if (call.symbol_reference is Class) {
339			error = true;
340			Report.error (source_reference, "use `new' operator to create new objects");
341			return false;
342		} else {
343			error = true;
344			Report.error (source_reference, "invocation not supported in this context");
345			return false;
346		}
347
348		var ret_type = mtype.get_return_type ();
349		var params = mtype.get_parameters ();
350
351		if (mtype is MethodType) {
352			unowned MemberAccess ma = (MemberAccess) call;
353			unowned Method m = ((MethodType) mtype).method_symbol;
354
355			if (m.coroutine) {
356				if (!is_yield_expression) {
357					// begin or end call of async method
358					if (ma.member_name != "end") {
359						// begin (possibly implicit)
360						if (ma.member_name != "begin") {
361							Report.deprecated (ma.source_reference, "implicit .begin is deprecated");
362						}
363						params = m.get_async_begin_parameters ();
364						ret_type = new VoidType ();
365					} else {
366						// end
367						params = m.get_async_end_parameters ();
368					}
369				} else if (ma.member_name == "begin" || ma.member_name == "end") {
370					error = true;
371					Report.error (ma.source_reference, "use of `%s' not allowed in yield statement".printf (ma.member_name));
372				}
373			}
374
375			int n_type_params = m.get_type_parameters ().size;
376			int n_type_args = ma.get_type_arguments ().size;
377			if (n_type_args > 0 && n_type_args < n_type_params) {
378				error = true;
379				Report.error (ma.source_reference, "too few type arguments");
380				return false;
381			} else if (n_type_args > 0 && n_type_args > n_type_params) {
382				error = true;
383				Report.error (ma.source_reference, "too many type arguments");
384				return false;
385			}
386		}
387
388		// FIXME partial code duplication in ObjectCreationExpression.check
389
390		Expression last_arg = null;
391
392		Iterator<Expression> arg_it = argument_list.iterator ();
393		foreach (Parameter param in params) {
394			if (!param.check (context)) {
395				error = true;
396			}
397
398			if (param.ellipsis) {
399				break;
400			}
401
402			if (param.params_array) {
403				var array_type = (ArrayType) param.variable_type;
404				while (arg_it.next ()) {
405					Expression arg = arg_it.get ();
406
407					/* store expected type for callback parameters */
408					arg.target_type = array_type.element_type;
409					arg.target_type.value_owned = array_type.value_owned;
410				}
411				break;
412			}
413
414			if (arg_it.next ()) {
415				Expression arg = arg_it.get ();
416
417				/* store expected type for callback parameters */
418				arg.formal_target_type = param.variable_type;
419				arg.target_type = arg.formal_target_type.get_actual_type (target_object_type, method_type_args, this);
420
421				last_arg = arg;
422			}
423		}
424
425		// concatenate stringified arguments for methods with attribute [Print]
426		if (mtype is MethodType && ((MethodType) mtype).method_symbol.get_attribute ("Print") != null) {
427			var template = new Template (source_reference);
428			foreach (Expression arg in argument_list) {
429				arg.parent_node = null;
430				template.add_expression (arg);
431			}
432			argument_list.clear ();
433			add_argument (template);
434		}
435
436		// printf arguments
437		if (mtype is MethodType && ((MethodType) mtype).method_symbol.printf_format) {
438			StringLiteral format_literal = null;
439			if (last_arg is NullLiteral) {
440				// do not replace explicit null
441			} else if (last_arg != null) {
442				// use last argument as format string
443				format_literal = StringLiteral.get_format_literal (last_arg);
444				if (format_literal == null && argument_list.size == params.size - 1) {
445					// insert "%s" to avoid issues with embedded %
446					format_literal = new StringLiteral ("\"%s\"");
447					format_literal.target_type = context.analyzer.string_type.copy ();
448					argument_list.insert (argument_list.size - 1, format_literal);
449
450					// recreate iterator and skip to right position
451					arg_it = argument_list.iterator ();
452					foreach (Parameter param in params) {
453						if (param.ellipsis || param.params_array) {
454							break;
455						}
456						arg_it.next ();
457					}
458				}
459			} else {
460				// use instance as format string for string.printf (...)
461				unowned MemberAccess? ma = call as MemberAccess;
462				if (ma != null) {
463					format_literal = StringLiteral.get_format_literal (ma.inner);
464				}
465			}
466			if (format_literal != null) {
467				string format = format_literal.eval ();
468				if (!context.analyzer.check_print_format (format, arg_it, source_reference)) {
469					error = true;
470					return false;
471				}
472			}
473		}
474
475		bool force_lambda_method_closure = false;
476		foreach (Expression arg in argument_list) {
477			if (!arg.check (context)) {
478				error = true;
479				continue;
480			}
481
482			if (arg is LambdaExpression && ((LambdaExpression) arg).method.closure) {
483				force_lambda_method_closure = true;
484			}
485		}
486		// force all lambda arguments using the same closure scope
487		// TODO https://gitlab.gnome.org/GNOME/vala/issues/59
488		if (!error && force_lambda_method_closure) {
489			foreach (Expression arg in argument_list) {
490				unowned LambdaExpression? lambda = arg as LambdaExpression;
491				if (lambda != null && lambda.method.binding != MemberBinding.STATIC) {
492					lambda.method.closure = true;
493				}
494			}
495		}
496
497		if (ret_type is VoidType) {
498			// void return type
499			if (!(parent_node is ExpressionStatement)
500			    && !(parent_node is ForStatement)
501			    && !(parent_node is YieldStatement)) {
502				// A void method invocation can be in the initializer or
503				// iterator of a for statement
504				error = true;
505				Report.error (source_reference, "invocation of void method not allowed as expression");
506				return false;
507			}
508		}
509
510		formal_value_type = ret_type.copy ();
511		value_type = formal_value_type.get_actual_type (target_object_type, method_type_args, this);
512
513		if (is_yield_expression) {
514			if (!(mtype is MethodType) || !((MethodType) mtype).method_symbol.coroutine) {
515				error = true;
516				Report.error (source_reference, "yield expression requires async method");
517			}
518			if (context.analyzer.current_method == null || !context.analyzer.current_method.coroutine) {
519				error = true;
520				Report.error (source_reference, "yield expression not available outside async method");
521			}
522		}
523
524		if (mtype is MethodType) {
525			unowned Method m = ((MethodType) mtype).method_symbol;
526			if (m.returns_floating_reference) {
527				value_type.floating_reference = true;
528			}
529			if (m.returns_modified_pointer) {
530				unowned Expression inner = ((MemberAccess) call).inner;
531				inner.lvalue = true;
532				unowned Property? prop = inner.symbol_reference as Property;
533				if (prop != null && (prop.set_accessor == null || !prop.set_accessor.writable)) {
534					error = true;
535					Report.error (inner.source_reference, "Property `%s' is read-only".printf (prop.get_full_name ()));
536				}
537			}
538			// avoid passing possible null to ref_sink_function without checking
539			if (tree_can_fail && !value_type.nullable && value_type.floating_reference && ret_type is ObjectType) {
540				value_type.nullable = true;
541			}
542
543			unowned Signal? sig = m.parent_symbol as Signal;
544			if (sig != null && m.name == "disconnect") {
545				if (!argument_list.is_empty && argument_list[0] is LambdaExpression) {
546					error = true;
547					Report.error (source_reference, "Cannot disconnect lambda expression from signal");
548					return false;
549				}
550			}
551
552			unowned DynamicSignal? dynamic_sig = m.parent_symbol as DynamicSignal;
553			if (dynamic_sig != null && dynamic_sig.handler != null) {
554				dynamic_sig.return_type = dynamic_sig.handler.value_type.get_return_type ().copy ();
555				bool first = true;
556				foreach (Parameter param in dynamic_sig.handler.value_type.get_parameters ()) {
557					if (first) {
558						// skip sender parameter
559						first = false;
560					} else {
561						dynamic_sig.add_parameter (param.copy ());
562					}
563				}
564				dynamic_sig.handler.target_type = new DelegateType (dynamic_sig.get_delegate (new ObjectType ((ObjectTypeSymbol) dynamic_sig.parent_symbol), this));
565			}
566
567			if (m != null && m.has_type_parameters ()) {
568				unowned MemberAccess ma = (MemberAccess) call;
569				if (ma.get_type_arguments ().size == 0) {
570					// infer type arguments
571					foreach (var type_param in m.get_type_parameters ()) {
572						DataType type_arg = null;
573
574						// infer type arguments from arguments
575						arg_it = argument_list.iterator ();
576						foreach (Parameter param in params) {
577							if (param.ellipsis || param.params_array) {
578								break;
579							}
580
581							if (arg_it.next ()) {
582								Expression arg = arg_it.get ();
583
584								type_arg = param.variable_type.infer_type_argument (type_param, arg.value_type);
585								if (type_arg != null) {
586									break;
587								}
588
589								arg.target_type = arg.formal_target_type.get_actual_type (target_object_type, method_type_args, this);
590							}
591						}
592
593						// infer type arguments from expected return type
594						if (type_arg == null && target_type != null) {
595							type_arg = m.return_type.infer_type_argument (type_param, target_type);
596						}
597
598						if (type_arg == null) {
599							error = true;
600							Report.error (ma.source_reference, "cannot infer generic type argument for type parameter `%s'".printf (type_param.get_full_name ()));
601							return false;
602						}
603
604						ma.add_type_argument (type_arg);
605					}
606
607					// recalculate argument target types with new information
608					arg_it = argument_list.iterator ();
609					foreach (Parameter param in params) {
610						if (param.ellipsis || param.params_array) {
611							break;
612						}
613
614						if (arg_it.next ()) {
615							Expression arg = arg_it.get ();
616
617							arg.target_type = arg.formal_target_type.get_actual_type (target_object_type, method_type_args, this);
618						}
619					}
620
621					// recalculate return value type with new information
622					value_type = formal_value_type.get_actual_type (target_object_type, method_type_args, this);
623				}
624			}
625			// replace method-type if needed for proper argument-check in semantic-analyser
626			if (m != null && m.coroutine) {
627				unowned MemberAccess ma = (MemberAccess) call;
628				if (ma.member_name == "end") {
629					mtype = new MethodType (m.get_end_method ());
630				}
631			}
632		}
633
634		if (!context.analyzer.check_arguments (this, mtype, params, argument_list)) {
635			error = true;
636			return false;
637		}
638
639		//Resolve possible generic-type in SizeofExpression used as parameter default-value
640		foreach (Expression arg in argument_list) {
641			unowned SizeofExpression? sizeof_expr = arg as SizeofExpression;
642			if (sizeof_expr != null && sizeof_expr.type_reference is GenericType) {
643				var sizeof_type = sizeof_expr.type_reference.get_actual_type (target_object_type, method_type_args, this);
644				replace_expression (arg, new SizeofExpression (sizeof_type, source_reference));
645			}
646		}
647
648		/* Check for constructv chain up */
649		if (base_cm != null && base_cm.is_variadic () && argument_list.size == base_cm.get_parameters ().size) {
650			var this_last_arg = argument_list[argument_list.size - 1];
651			if (this_last_arg.value_type is StructValueType && this_last_arg.value_type.type_symbol == context.analyzer.va_list_type.type_symbol) {
652				is_constructv_chainup = true;
653			}
654		}
655
656		value_type.check (context);
657
658		// FIXME code duplication in ObjectCreationExpression.check
659		if (tree_can_fail) {
660			if (parent_node is LocalVariable || parent_node is ExpressionStatement) {
661				// simple statements, no side effects after method call
662			} else if (!(context.analyzer.current_symbol is Block)) {
663				// can't handle errors in field initializers
664				error = true;
665				Report.error (source_reference, "Field initializers must not throw errors");
666			} else {
667				// store parent_node as we need to replace the expression in the old parent node later on
668				var old_parent_node = parent_node;
669
670				var local = new LocalVariable (value_type.copy (), get_temp_name (), null, source_reference);
671				var decl = new DeclarationStatement (local, source_reference);
672
673				// don't carry floating reference any further if the target-type is unknown
674				if (target_type == null) {
675					local.variable_type.floating_reference = false;
676				}
677
678				insert_statement (context.analyzer.insert_block, decl);
679
680				var temp_access = SemanticAnalyzer.create_temp_access (local, target_type);
681				temp_access.formal_target_type = formal_target_type;
682
683				// don't set initializer earlier as this changes parent_node and parent_statement
684				local.initializer = this;
685				decl.check (context);
686
687				// move temp variable to insert block to ensure the
688				// variable is in the same block as the declaration
689				// otherwise there will be scoping issues in the generated code
690				var block = (Block) context.analyzer.current_symbol;
691				block.remove_local_variable (local);
692				context.analyzer.insert_block.add_local_variable (local);
693
694				old_parent_node.replace_expression (this, temp_access);
695				temp_access.check (context);
696			}
697		}
698
699		return !error;
700	}
701
702	public override void emit (CodeGenerator codegen) {
703		unowned MethodType? method_type = call.value_type as MethodType;
704		if (method_type != null && method_type.method_symbol.parent_symbol is Signal) {
705			((MemberAccess) call).inner.emit (codegen);
706		} else {
707			call.emit (codegen);
708		}
709
710		foreach (Expression expr in argument_list) {
711			expr.emit (codegen);
712		}
713
714		codegen.visit_method_call (this);
715
716		codegen.visit_expression (this);
717	}
718
719	public override void get_defined_variables (Collection<Variable> collection) {
720		call.get_defined_variables (collection);
721
722		foreach (Expression arg in argument_list) {
723			arg.get_defined_variables (collection);
724		}
725	}
726
727	public override void get_used_variables (Collection<Variable> collection) {
728		call.get_used_variables (collection);
729
730		foreach (Expression arg in argument_list) {
731			arg.get_used_variables (collection);
732		}
733	}
734
735	public StringLiteral? get_format_literal () {
736		unowned MethodType? mtype = this.call.value_type as MethodType;
737		if (mtype != null) {
738			int format_arg = mtype.method_symbol.get_format_arg_index ();
739			if (format_arg >= 0 && format_arg < argument_list.size) {
740				return StringLiteral.get_format_literal (argument_list[format_arg]);
741			}
742		}
743
744		return null;
745	}
746
747	public override string to_string () {
748		var b = new StringBuilder ();
749		b.append_c ('(');
750		if (is_yield_expression) {
751			b.append ("yield ");
752		}
753		b.append (call.to_string ());
754		b.append_c ('(');
755
756		bool first = true;
757		foreach (var expr in argument_list) {
758			if (!first) {
759				b.append (", ");
760			}
761			b.append (expr.to_string ());
762			first = false;
763		}
764		b.append ("))");
765
766		return b.str;
767	}
768}
769