[fpc-devel] Functors

[Blaise at blaise.ru]

I propose that the support for https://en.wikipedia.org/wiki/Function_object be added to the FPC.

A subset of such functionality already existed as a part of my implementation of closures, so I extended that part to implement the core feature for allowing functors -- overloading of the call operator: when round brackets are applied to an instance of a record, object/class, or interface type, they are translated into a call to the method Invoke of that instance. The attached proof-of-concept functors-1.patch allows the following test case to be compiled:
-------8<-------
type I = interface
	procedure Invoke;
end;

type C = class(TInterfacedObject, I)
	class function Invoke(const N: Integer): Integer; overload;
	procedure Invoke; overload;
end;
class function C.Invoke(const N: Integer): Integer;
begin
	result := N + 9
end;
procedure C.Invoke;
begin
	writeln(ClassName, '.Invoke')
end;

type H = class helper for C
	procedure Invoke(const S: string); overload;
end;
procedure H.Invoke(const S: string);
begin
	writeln('H.Invoke("', S, '")')
end;

var aC: C;
var anI: I;
begin
	aC := C.Create;
	writeln( aC(33) );
	aC('hello');

	anI := aC;
	anI()
end.
-------8<-------
Important design points:
1) Applying round brackets to instances does not collide with the existing syntax;
2) Naturally, helpers are able to turn helpees into functors;
3) Operator () cannot be applied to types -- that would clash with explicit type conversions;
4) Explicit empty argument lists are required -- unorthogonal to routines and procedural variables, but clarity must win here;
5) {$modeswitch Closures} is required (modeswitch_closures.patch from https://lists.freepascal.org/pipermail/fpc-devel/2021-December/044261.html) -- functors are closure-adjacent in the area of functional programming.

The parts that are currently missing:
1) Implicit conversion from functors to method pointers -- should be fairly trivial to implement;
2) Support for generics -- should be straightforward as well;
3) The OPERATOR keyword instead of PROCEDURE/FUNCTION for methods Invoke -- should we choose to require it -- would be somewhat more complicated.

-- 
βþ
-------------- next part --------------
# HG changeset patch
# User Blaise.ru
# Date 1640402948 -10800
#      Sat Dec 25 06:29:08 2021 +0300
+ Functors: applying round brackets to instances calls their method Invoke

diff -r 3ecaef5e9a49 -r 0ac7231ddc94 pexpr.pas
--- a/pexpr.pas	Sat Dec 25 21:36:11 2021 +0300
+++ b/pexpr.pas	Sat Dec 25 06:29:08 2021 +0300
@@ -2762,45 +2762,73 @@
 
           else
             begin
-              { is this a procedure variable ? }
-              if assigned(p1.resultdef) and
-                 (p1.resultdef.typ=procvardef) then
-                begin
-                  { Typenode for typecasting or expecting a procvar }
-                  if (p1.nodetype=typen) or
-                     (
-                      assigned(getprocvardef) and
-                      equal_defs(p1.resultdef,getprocvardef)
-                     ) then
+              if assigned(p1.resultdef) then
+                case p1.resultdef.typ of
+                  { a procedural variable }
+                  procvardef:
                     begin
-                      if try_to_consume(_LKLAMMER) then
+                      { Typenode for typecasting or expecting a procvar }
+                      if (p1.nodetype=typen) or
+                         (
+                          assigned(getprocvardef) and
+                          equal_defs(p1.resultdef,getprocvardef)
+                         ) then
                         begin
-                          p1:=comp_expr([ef_accept_equal]);
-                          consume(_RKLAMMER);
-                          p1:=ctypeconvnode.create_explicit(p1,p1.resultdef);
+                          if try_to_consume(_LKLAMMER) then
+                            begin
+                              p1:=comp_expr([ef_accept_equal]);
+                              consume(_RKLAMMER);
+                              p1:=ctypeconvnode.create_explicit(p1,p1.resultdef);
+                            end
+                          else
+                            again:=false
                         end
                       else
-                        again:=false
-                    end
+                        begin
+                          if try_to_consume(_LKLAMMER) then
+                            begin
+                              p2:=parse_paras(false,false,_RKLAMMER);
+                              consume(_RKLAMMER);
+                              p1:=ccallnode.create_procvar(p2,p1);
+                              { proc():= is never possible }
+                              if token=_ASSIGNMENT then
+                                begin
+                                  Message(parser_e_illegal_expression);
+                                  p1.free;
+                                  p1:=cerrornode.create;
+                                  again:=false;
+                                end;
+                            end
+                          else
+                            again:=false;
+                        end;
+                    end;
+                  { a functor }
+                  recorddef, objectdef:
+                    if (token=_LKLAMMER)
+                       and (m_closures in current_settings.modeswitches)
+                        then
+                      begin
+                        structh:=tabstractrecorddef(p1.resultdef);
+                        if structh.typ=objectdef then
+                          searchsym_in_class(tobjectdef(structh),tobjectdef(structh),'INVOKE',srsym,srsymtable,[ssf_search_helper])
+                        else
+                          searchsym_in_record(trecorddef(structh),'INVOKE',srsym,srsymtable);
+                        if assigned(srsym) and (srsym.typ=procsym) then
+                          do_proc_call(srsym,srsymtable,structh,false,again,p1,[],nil)
+                        else
+                          begin
+                            // TODO: BETTER ERROR
+                            Message1(sym_e_id_no_member,'method Invoke');
+                            p1.free;
+                            p1:=cerrornode.create;
+                            again:=false;
+                          end;
+                      end
+                    else
+                      again:=false;
                   else
-                    begin
-                      if try_to_consume(_LKLAMMER) then
-                        begin
-                          p2:=parse_paras(false,false,_RKLAMMER);
-                          consume(_RKLAMMER);
-                          p1:=ccallnode.create_procvar(p2,p1);
-                          { proc():= is never possible }
-                          if token=_ASSIGNMENT then
-                            begin
-                              Message(parser_e_illegal_expression);
-                              p1.free;
-                              p1:=cerrornode.create;
-                              again:=false;
-                            end;
-                        end
-                      else
-                        again:=false;
-                    end;
+                    again:=false;
                 end
               else
                 again:=false;