~ ncgutil: generate interface thunks for local classes too

~ nld: during the first pass, we rewrite the nodes that load captured variables, except for nodes marked with the new flag loadnf_captured_param
= pdecobj, symdef: factored out tobjectdef.register_implemented_interface
+ pexpr: access to captured variables from expressions; nameless routine declarations
+ symconst: new flags for tprocoption (po_nameless, po_has_closure) and tobjectoption (oo_is_nameless)
~ symdef: mangled name generator is now aware of local classes and interfaces
+ symsym: new field tabstractnormalvarsym.captured_into holds a reference to a new location for the captured variable

git-svn-id: http://svn.freepascal.org/svn/fpc/branches/blaise@20138 3ad0048d-3df7-0310-abae-a5850022a9f2

7 files changed, 80 insertions, 17 deletions

diff --git a/closures/compiler/ncgutil.pas b/closures/compiler/ncgutil.pas
index 093708bf55..be668fd0cb 100644
--- a/closures/compiler/ncgutil.pas
+++ b/closures/compiler/ncgutil.pas
@@ -3075,9 +3075,16 @@ implementation
         for i:=0 to st.DefList.Count-1 do
           begin
             def:=tdef(st.DefList[i]);
-            { if def can contain nested types then handle it symtable }
-            if def.typ in [objectdef,recorddef] then
-              gen_intf_wrappers(list,tabstractrecorddef(def).symtable,true);
+            { if def can contain nested types then handle its symtable }
+            case def.typ of
+              objectdef,recorddef:
+                gen_intf_wrappers(list,tabstractrecorddef(def).symtable,true);
+              procdef:
+                // check for local classes; currently, we only use them for closures
+                // TODO: this can slow codegen down dramatically?!
+                if assigned(tprocdef(def).localst) then
+                  gen_intf_wrappers(list,tprocdef(def).localst,true);
+            end;
             if is_class(def) then
               gen_intf_wrapper(list,tobjectdef(def));
           end;
diff --git a/closures/compiler/nld.pas b/closures/compiler/nld.pas
index 2f2dc872af..fa31b825ed 100644
--- a/closures/compiler/nld.pas
+++ b/closures/compiler/nld.pas
@@ -44,7 +44,10 @@ interface
            Be really carefull when using this flag! }
          loadnf_isinternal_ignoreconst,
 
-         loadnf_only_uninitialized_hint
+         loadnf_only_uninitialized_hint,
+         // the node loads a captured formal parameter from its original location;
+         // such node is marked so, so it will not get rewritten during the first pass
+         loadnf_captured_param
         );
 
        tloadnode = class(tunarynode)
@@ -167,7 +170,7 @@ implementation
       cutils,verbose,globtype,globals,systems,
       symnot,symtable,
       defutil,defcmp,
-      htypechk,pass_1,procinfo,paramgr,
+      htypechk,pass_1,procinfo,paramgr,pnameless,
       cpuinfo,
       ncon,ninl,ncnv,nmem,ncal,nutils,nbas,
       cgobj,cgbase
@@ -393,6 +396,17 @@ implementation
             localvarsym,
             paravarsym :
               begin
+                if symtableentry.typ in [localvarsym,paravarsym] then
+                  begin
+                    // if the variable has been captured after the creation of this node,
+                    //   then this node is no longer relevant,
+                    //     and we shall load the variable's new location instead
+                    // the exception is the case when we access the original location
+                    //   in order to copy the value into the capturer
+                    if tabstractnormalvarsym(symtableentry).is_captured
+                        and not (loadnf_captured_param in loadnodeflags) then
+                      exit( load_captured_variable(current_procinfo.procdef, tabstractnormalvarsym(symtableentry)) );
+                  end;
                 if assigned(left) then
                   firstpass(left);
                 if not is_addr_param_load and
diff --git a/closures/compiler/pdecobj.pas b/closures/compiler/pdecobj.pas
index 1c29df2437..098dcc67d1 100644
--- a/closures/compiler/pdecobj.pas
+++ b/closures/compiler/pdecobj.pas
@@ -268,13 +268,7 @@ implementation
         if current_objectdef.find_implemented_interface(intfdef)<>nil then
           Message1(sym_e_duplicate_id,intfdef.objname^)
         else
-          begin
-            { allocate and prepare the GUID only if the class
-              implements some interfaces. }
-            if current_objectdef.ImplementedInterfaces.count = 0 then
-              current_objectdef.prepareguid;
-            current_objectdef.ImplementedInterfaces.Add(TImplementedInterface.Create(intfdef));
-          end;
+          current_objectdef.register_implemented_interface(intfdef);
       end;
 
 
diff --git a/closures/compiler/pexpr.pas b/closures/compiler/pexpr.pas
index 98002d8b10..2678308a86 100644
--- a/closures/compiler/pexpr.pas
+++ b/closures/compiler/pexpr.pas
@@ -70,7 +70,7 @@ implementation
        nmat,nadd,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,nutils,
        { parser }
        scanner,
-       pbase,pinline,ptype,pgenutil,
+       pbase,pinline,ptype,pgenutil,pnameless,
        { codegen }
        cgbase,procinfo,cpuinfo
        ;
@@ -2248,8 +2248,15 @@ implementation
                           p1:=csubscriptnode.create(srsym,p1);
                       end
                     else
-                      { regular non-field load }
-                      p1:=cloadnode.create(srsym,srsymtable);
+                      begin
+                        if srsym.typ in [localvarsym,paravarsym] then
+                          p1:=handle_possible_capture(current_procinfo.procdef, tabstractnormalvarsym(srsym))
+                        else
+                          p1:=nil;
+                        if not assigned(p1) then
+                          { regular non-field load }
+                          p1:=cloadnode.create(srsym,srsymtable);
+                      end
                   end;
 
                 syssym :
@@ -2946,6 +2953,13 @@ implementation
                p1:=cinlinenode.create(in_objc_protocol_x,false,p1);
              end;
 
+             // nameless routine
+             _PROCEDURE, _FUNCTION:
+               if assigned(current_procinfo) then
+                 p1:=parse_nameless_routine(current_procinfo.procdef)
+               else // TODO: support this later? Delphi doesn't
+                 internalerror(20120121);
+
              else
                begin
                  Message(parser_e_illegal_expression);
diff --git a/closures/compiler/symconst.pas b/closures/compiler/symconst.pas
index 3c40411871..af3ea2c722 100644
--- a/closures/compiler/symconst.pas
+++ b/closures/compiler/symconst.pas
@@ -320,7 +320,11 @@ type
        simply not see the frame pointer parameter, and since the caller cleans
        up the stack will also remain balanced) }
     po_delphi_nested_cc,
-    po_rtlproc
+    po_rtlproc,
+    // nameless routine (including closure)
+    po_nameless,
+    // has at least one closure declared in the body
+    po_has_closure
   );
   tprocoptions=set of tprocoption;
 
@@ -382,7 +386,11 @@ type
     oo_is_formal,         { the class is only formally defined in this module (x = objcclass; external [name 'x'];) }
     oo_is_classhelper,    { objcclasses that represent categories, and Delpi-style class helpers, are marked like this }
     oo_has_class_constructor, { the object/class has a class constructor }
-    oo_has_class_destructor   { the object/class has a class destructor  }
+    oo_has_class_destructor,   { the object/class has a class destructor  }
+    // the interface that has no identifier; structural type equivalence is used
+    //   currently, this flag is only used for closures
+    //     TODO: we can get rid of it if we implement type coersion for COM-interfaces
+    oo_is_nameless
   );
   tobjectoptions=set of tobjectoption;
 
diff --git a/closures/compiler/symdef.pas b/closures/compiler/symdef.pas
index 6b9852fc52..4dea14eb01 100644
--- a/closures/compiler/symdef.pas
+++ b/closures/compiler/symdef.pas
@@ -312,7 +312,10 @@ interface
           function  members_need_inittable : boolean;
           function  find_implemented_interface(aintfdef:tobjectdef):TImplementedInterface;
           { this should be called when this class implements an interface }
+          procedure register_implemented_interface(const intfdef: tobjectdef);
+       strict private
           procedure prepareguid;
+       public
           function  is_publishable : boolean;override;
           function  is_related(d : tdef) : boolean;override;
           function  needs_inittable : boolean;override;
@@ -907,10 +910,12 @@ implementation
         i   : longint;
         crc : dword;
         hp  : tparavarsym;
+      label again; // TODO: refactor this abomination
       begin
         prefix:='';
         if not assigned(st) then
          internalerror(200204212);
+      again:
         { sub procedures }
         while (st.symtabletype=localsymtable) do
          begin
@@ -968,6 +973,9 @@ implementation
            prefix:=tabstractrecorddef(st.defowner).objname^+'_$_'+prefix;
            st:=st.defowner.owner;
          end;
+        if st.symtabletype = localsymtable then
+          // local classes and interfaces
+          goto again;
         { symtable must now be static or global }
         if not(st.symtabletype in [staticsymtable,globalsymtable]) then
           internalerror(200204175);
@@ -4859,6 +4867,15 @@ implementation
       end;
 
 
+    procedure tobjectdef.register_implemented_interface(const intfdef: tobjectdef);
+      begin
+        // allocate the GUID only if the class implements at least one interface
+        if ImplementedInterfaces.count = 0 then
+          prepareguid;
+        ImplementedInterfaces.Add(TImplementedInterface.Create(intfdef));
+      end;
+
+
     procedure tobjectdef.prepareguid;
       begin
         { set up guid }
diff --git a/closures/compiler/symsym.pas b/closures/compiler/symsym.pas
index c91d3e5d80..653867552e 100644
--- a/closures/compiler/symsym.pas
+++ b/closures/compiler/symsym.pas
@@ -180,11 +180,14 @@ interface
           defaultconstsymderef : tderef;
           localloc      : TLocation; { register/reference for local var }
           initialloc    : TLocation; { initial location so it can still be initialized later after the location was changed by SSA }
+          // if var is captured by a closure, this refers to a field of the class TCapturer
+          captured_into: tfieldvarsym;
           constructor create(st:tsymtyp;const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
           constructor ppuload(st:tsymtyp;ppufile:tcompilerppufile);
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure buildderef;override;
           procedure deref;override;
+          function is_captured: boolean; inline;
       end;
 
       tlocalvarsym = class(tabstractnormalvarsym)
@@ -1397,6 +1400,12 @@ implementation
       end;
 
 
+    function tabstractnormalvarsym.is_captured: boolean; inline;
+      begin
+        result:=assigned(captured_into)
+      end;
+
+
 {****************************************************************************
                              Tstaticvarsym
 ****************************************************************************}