Moved "generate_specialization" from "ptype.pas" to "pgenutil.pas"

git-svn-id: branches/svenbarth/generics@17403 -

compiler/pexpr.pas

@@ -66,7 +66,7 @@ implementation
        nmat,nadd,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,nutils,
        { parser }
        scanner,
-       pbase,pinline,ptype,
+       pbase,pinline,ptype,pgenutil,
        { codegen }
        cgbase,procinfo,cpuinfo
        ;

compiler/pgenutil.pas

@@ -26,6 +26,335 @@ unit pgenutil;
 
 interface
 
+uses
+  symtype;
+
+    procedure generate_specialization(var tt:tdef;parse_class_parent:boolean);
+
 implementation
 
-end.
+uses
+  { common }
+  cclasses,cutils,
+  { global }
+  globals,tokens,verbose,
+  { symtable }
+  symconst,symbase,symdef,symsym,symtable,
+  { modules }
+  fmodule,
+  { pass 1 }
+  node,nobj,
+  { parser }
+  scanner,
+  pbase,pexpr,pdecsub,ptype;
+
+
+    procedure generate_specialization(var tt:tdef;parse_class_parent:boolean);
+      var
+        st  : TSymtable;
+        srsym : tsym;
+        pt2 : tnode;
+        found,
+        first,
+        err : boolean;
+        i,
+        j,
+        gencount : longint;
+        sym : tsym;
+        genericdef : tstoreddef;
+        genericsym,
+        generictype : ttypesym;
+        genericdeflist : TFPObjectList;
+        generictypelist : TFPObjectList;
+        oldsymtablestack   : tsymtablestack;
+        oldextendeddefs    : TFPHashObjectList;
+        hmodule : tmodule;
+        pu : tused_unit;
+        uspecializename,
+        specializename : string;
+        vmtbuilder : TVMTBuilder;
+        onlyparsepara : boolean;
+        specializest : tsymtable;
+        item: psymtablestackitem;
+        def : tdef;
+      begin
+        { retrieve generic def that we are going to replace }
+        genericdef:=tstoreddef(tt);
+        tt:=nil;
+        onlyparsepara:=false;
+
+        if not assigned(genericdef.typesym) or
+            (genericdef.typesym.typ<>typesym) then
+           internalerror(2011042701);
+
+        genericsym:=ttypesym(genericdef.typesym);
+        if genericsym.gendeflist.Count=0 then
+          begin
+            { TODO : search for other generics with the same name }
+            Message(parser_e_special_onlygenerics);
+            tt:=generrordef;
+            onlyparsepara:=true;
+          end;
+
+        { only need to record the tokens, then we don't know the type yet  ... }
+        if parse_generic then
+          begin
+            { ... but we have to insert a def into the symtable else the deflist
+              of generic and specialization might not be equally sized which
+              is later assumed }
+            tt:=tundefineddef.create;
+            if parse_class_parent then
+              tt:=genericdef;
+            onlyparsepara:=true;
+          end;
+
+        { Only parse the parameters for recovery or
+          for recording in genericbuf }
+        if onlyparsepara then
+          begin
+            consume(_LSHARPBRACKET);
+            repeat
+              pt2:=factor(false,true);
+              pt2.free;
+            until not try_to_consume(_COMMA);
+            consume(_RSHARPBRACKET);
+            exit;
+          end;
+
+        if not try_to_consume(_LT) then
+          consume(_LSHARPBRACKET);
+
+        generictypelist:=TFPObjectList.create(false);
+        genericdeflist:=TFPObjectList.Create(false);
+
+        { Parse type parameters }
+        if not assigned(genericdef.typesym) then
+          internalerror(200710173);
+        err:=false;
+        first:=true;
+        specializename:='';
+        while not (token in [_GT,_RSHARPBRACKET]) do
+          begin
+            if not first then
+              consume(_COMMA)
+            else
+              first:=false;
+            pt2:=factor(false,true);
+            if pt2.nodetype=typen then
+              begin
+                if df_generic in pt2.resultdef.defoptions then
+                  Message(parser_e_no_generics_as_params);
+                genericdeflist.Add(pt2.resultdef);
+                if not assigned(pt2.resultdef.typesym) then
+                  message(type_e_generics_cannot_reference_itself)
+                else
+                  specializename:=specializename+'$'+pt2.resultdef.typesym.realname;
+              end
+            else
+              begin
+                Message(type_e_type_id_expected);
+                err:=true;
+              end;
+            pt2.free;
+          end;
+
+        if err then
+          begin
+            try_to_consume(_RSHARPBRACKET);
+            exit;
+          end;
+
+        { check whether we have a generic with the correct amount of params }
+        found:=false;
+        for i:=0 to genericsym.gendeflist.Count-1 do begin
+          def:=tdef(genericsym.gendeflist[i]);
+          { select the symtable containing the params }
+          case def.typ of
+            procdef:
+              st:=def.GetSymtable(gs_para);
+            objectdef,
+            recorddef:
+              st:=def.GetSymtable(gs_record);
+            arraydef:
+              st:=tarraydef(def).symtable;
+            procvardef:
+              st:=def.GetSymtable(gs_para);
+            else
+              internalerror(200511182);
+          end;
+
+          gencount:=0;
+          for j:=0 to st.SymList.Count-1 do
+            begin
+              if sp_generic_para in tsym(st.SymList[j]).symoptions then
+                inc(gencount);
+            end;
+
+          if gencount=genericdeflist.count then
+            begin
+              found:=true;
+              break;
+            end;
+        end;
+
+        if not found then
+          begin
+            identifier_not_found(genericdef.typename);
+            tt:=generrordef;
+            exit;
+          end;
+
+        { we've found the correct def, so use it }
+        genericdef:=tstoreddef(def);
+
+        { build the new type's name }
+        specializename:=genericdef.typesym.realname+specializename;
+        uspecializename:=upper(specializename);
+
+        { build the list containing the types for the generic params }
+        gencount:=0;
+        for i:=0 to st.SymList.Count-1 do
+          begin
+            sym:=tsym(st.SymList[i]);
+            if sp_generic_para in sym.symoptions then
+              begin
+                if gencount=genericdeflist.Count then
+                  internalerror(2011042702);
+                generictype:=ttypesym.create(sym.realname,tdef(genericdeflist[gencount]));
+                generictypelist.add(generictype);
+                inc(gencount);
+              end;
+          end;
+
+
+        { Special case if we are referencing the current defined object }
+        if assigned(current_structdef) and
+           (current_structdef.objname^=uspecializename) then
+          tt:=current_structdef;
+
+        { for units specializations can already be needed in the interface, therefor we
+          will use the global symtable. Programs don't have a globalsymtable and there we
+          use the localsymtable }
+        if current_module.is_unit then
+          specializest:=current_module.globalsymtable
+        else
+          specializest:=current_module.localsymtable;
+
+        { Can we reuse an already specialized type? }
+        if not assigned(tt) then
+          begin
+            srsym:=tsym(specializest.find(uspecializename));
+            if assigned(srsym) then
+              begin
+                if srsym.typ<>typesym then
+                  internalerror(200710171);
+                tt:=ttypesym(srsym).typedef;
+              end;
+          end;
+
+        if not assigned(tt) then
+          begin
+            { Setup symtablestack at definition time
+              to get types right, however this is not perfect, we should probably record
+              the resolved symbols }
+            oldsymtablestack:=symtablestack;
+            oldextendeddefs:=current_module.extendeddefs;
+            current_module.extendeddefs:=TFPHashObjectList.create(true);
+            symtablestack:=tdefawaresymtablestack.create;
+            if not assigned(genericdef) then
+              internalerror(200705151);
+            hmodule:=find_module_from_symtable(genericdef.owner);
+            if hmodule=nil then
+              internalerror(200705152);
+            pu:=tused_unit(hmodule.used_units.first);
+            while assigned(pu) do
+              begin
+                if not assigned(pu.u.globalsymtable) then
+                  internalerror(200705153);
+                symtablestack.push(pu.u.globalsymtable);
+                pu:=tused_unit(pu.next);
+              end;
+
+            if assigned(hmodule.globalsymtable) then
+              symtablestack.push(hmodule.globalsymtable);
+
+            { hacky, but necessary to insert the newly generated class properly }
+            item:=oldsymtablestack.stack;
+            while assigned(item) and (item^.symtable.symtablelevel>main_program_level) do
+              item:=item^.next;
+            if assigned(item) and (item^.symtable<>symtablestack.top) then
+              symtablestack.push(item^.symtable);
+
+            { Reparse the original type definition }
+            if not err then
+              begin
+                { First a new typesym so we can reuse this specialization and
+                  references to this specialization can be handled }
+                srsym:=ttypesym.create(specializename,generrordef);
+                specializest.insert(srsym);
+
+                if not assigned(genericdef.generictokenbuf) then
+                  internalerror(200511171);
+                current_scanner.startreplaytokens(genericdef.generictokenbuf);
+                read_named_type(tt,specializename,genericdef,generictypelist,false);
+                ttypesym(srsym).typedef:=tt;
+                tt.typesym:=srsym;
+
+                case tt.typ of
+                  { Build VMT indexes for classes }
+                  objectdef:
+                    begin
+                      vmtbuilder:=TVMTBuilder.Create(tobjectdef(tt));
+                      vmtbuilder.generate_vmt;
+                      vmtbuilder.free;
+                    end;
+                  { handle params, calling convention, etc }
+                  procvardef:
+                    begin
+                      if not check_proc_directive(true) then
+                        begin
+                          try_consume_hintdirective(ttypesym(srsym).symoptions,ttypesym(srsym).deprecatedmsg);
+                          consume(_SEMICOLON);
+                        end;
+                      parse_var_proc_directives(ttypesym(srsym));
+                      handle_calling_convention(tprocvardef(tt));
+                      if try_consume_hintdirective(ttypesym(srsym).symoptions,ttypesym(srsym).deprecatedmsg) then
+                        consume(_SEMICOLON);
+                    end;
+                end;
+                { Consume the semicolon if it is also recorded }
+                try_to_consume(_SEMICOLON);
+              end;
+
+            { Restore symtablestack }
+            current_module.extendeddefs.free;
+            current_module.extendeddefs:=oldextendeddefs;
+            symtablestack.free;
+            symtablestack:=oldsymtablestack;
+          end
+        else
+          begin
+            { There is comment few lines before ie 200512115
+              saying "We are parsing the same objectdef, the def index numbers
+              are the same". This is wrong (index numbers are not same)
+              in case there is specialization (S2 in this case) inside
+              specialized generic (G2 in this case) which is equal to
+              some previous specialization (S1 in this case). In that case,
+              new symbol is not added to currently specialized type
+              (S in this case) for that specializations (S2 in this case),
+              and this results in that specialization and generic definition
+              don't have same number of elements in their object symbol tables.
+              This patch adds undefined def to ensure that those
+              two symbol tables will have same number of elements.
+            }
+            tundefineddef.create;
+          end;
+
+        genericdeflist.free;
+        generictypelist.free;
+        if not try_to_consume(_GT) then
+          consume(_RSHARPBRACKET);
+      end;
+
+
+end.

compiler/ptype.pas

@@ -52,8 +52,6 @@ interface
     { generate persistent type information like VMT, RTTI and inittables }
     procedure write_persistent_type_info(st:tsymtable);
 
-    procedure generate_specialization(var tt:tdef;parse_class_parent:boolean);
-
 implementation
 
     uses
@@ -74,7 +72,7 @@ implementation
        nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,
        { parser }
        scanner,
-       pbase,pexpr,pdecsub,pdecvar,pdecobj,pdecl;
+       pbase,pexpr,pdecsub,pdecvar,pdecobj,pdecl,pgenutil;
 
 
     procedure resolve_forward_types;
@@ -143,314 +141,6 @@ implementation
       end;
 
 
-    procedure generate_specialization(var tt:tdef;parse_class_parent:boolean);
-      var
-        st  : TSymtable;
-        srsym : tsym;
-        pt2 : tnode;
-        found,
-        first,
-        err : boolean;
-        i,
-        j,
-        gencount : longint;
-        sym : tsym;
-        genericdef : tstoreddef;
-        genericsym,
-        generictype : ttypesym;
-        genericdeflist : TFPObjectList;
-        generictypelist : TFPObjectList;
-        oldsymtablestack   : tsymtablestack;
-        oldextendeddefs    : TFPHashObjectList;
-        hmodule : tmodule;
-        pu : tused_unit;
-        uspecializename,
-        specializename : string;
-        vmtbuilder : TVMTBuilder;
-        onlyparsepara : boolean;
-        specializest : tsymtable;
-        item: psymtablestackitem;
-        def : tdef;
-      begin
-        { retrieve generic def that we are going to replace }
-        genericdef:=tstoreddef(tt);
-        tt:=nil;
-        onlyparsepara:=false;
-
-        if not assigned(genericdef.typesym) or
-            (genericdef.typesym.typ<>typesym) then
-           internalerror(2011042701);
-
-        genericsym:=ttypesym(genericdef.typesym);
-        if genericsym.gendeflist.Count=0 then
-          begin
-            { TODO : search for other generics with the same name }
-            Message(parser_e_special_onlygenerics);
-            tt:=generrordef;
-            onlyparsepara:=true;
-          end;
-
-        { only need to record the tokens, then we don't know the type yet  ... }
-        if parse_generic then
-          begin
-            { ... but we have to insert a def into the symtable else the deflist
-              of generic and specialization might not be equally sized which
-              is later assumed }
-            tt:=tundefineddef.create;
-            if parse_class_parent then
-              tt:=genericdef;
-            onlyparsepara:=true;
-          end;
-
-        { Only parse the parameters for recovery or
-          for recording in genericbuf }
-        if onlyparsepara then
-          begin
-            consume(_LSHARPBRACKET);
-            repeat
-              pt2:=factor(false,true);
-              pt2.free;
-            until not try_to_consume(_COMMA);
-            consume(_RSHARPBRACKET);
-            exit;
-          end;
-
-        if not try_to_consume(_LT) then
-          consume(_LSHARPBRACKET);
-
-        generictypelist:=TFPObjectList.create(false);
-        genericdeflist:=TFPObjectList.Create(false);
-
-        { Parse type parameters }
-        if not assigned(genericdef.typesym) then
-          internalerror(200710173);
-        err:=false;
-        first:=true;
-        specializename:='';
-        while not (token in [_GT,_RSHARPBRACKET]) do
-          begin
-            if not first then
-              consume(_COMMA)
-            else
-              first:=false;
-            pt2:=factor(false,true);
-            if pt2.nodetype=typen then
-              begin
-                if df_generic in pt2.resultdef.defoptions then
-                  Message(parser_e_no_generics_as_params);
-                genericdeflist.Add(pt2.resultdef);
-                if not assigned(pt2.resultdef.typesym) then
-                  message(type_e_generics_cannot_reference_itself)
-                else
-                  specializename:=specializename+'$'+pt2.resultdef.typesym.realname;
-              end
-            else
-              begin
-                Message(type_e_type_id_expected);
-                err:=true;
-              end;
-            pt2.free;
-          end;
-
-        if err then
-          begin
-            try_to_consume(_RSHARPBRACKET);
-            exit;
-          end;
-
-        { check whether we have a generic with the correct amount of params }
-        found:=false;
-        for i:=0 to genericsym.gendeflist.Count-1 do begin
-          def:=tdef(genericsym.gendeflist[i]);
-          { select the symtable containing the params }
-          case def.typ of
-            procdef:
-              st:=def.GetSymtable(gs_para);
-            objectdef,
-            recorddef:
-              st:=def.GetSymtable(gs_record);
-            arraydef:
-              st:=tarraydef(def).symtable;
-            procvardef:
-              st:=def.GetSymtable(gs_para);
-            else
-              internalerror(200511182);
-          end;
-
-          gencount:=0;
-          for j:=0 to st.SymList.Count-1 do
-            begin
-              if sp_generic_para in tsym(st.SymList[j]).symoptions then
-                inc(gencount);
-            end;
-
-          if gencount=genericdeflist.count then
-            begin
-              found:=true;
-              break;
-            end;
-        end;
-
-        if not found then
-          begin
-            identifier_not_found(genericdef.typename);
-            tt:=generrordef;
-            exit;
-          end;
-
-        { we've found the correct def, so use it }
-        genericdef:=tstoreddef(def);
-
-        { build the new type's name }
-        specializename:=genericdef.typesym.realname+specializename;
-        uspecializename:=upper(specializename);
-
-        { build the list containing the types for the generic params }
-        gencount:=0;
-        for i:=0 to st.SymList.Count-1 do
-          begin
-            sym:=tsym(st.SymList[i]);
-            if sp_generic_para in sym.symoptions then
-              begin
-                if gencount=genericdeflist.Count then
-                  internalerror(2011042702);
-                generictype:=ttypesym.create(sym.realname,tdef(genericdeflist[gencount]));
-                generictypelist.add(generictype);
-                inc(gencount);
-              end;
-          end;
-
-
-        { Special case if we are referencing the current defined object }
-        if assigned(current_structdef) and
-           (current_structdef.objname^=uspecializename) then
-          tt:=current_structdef;
-
-        { for units specializations can already be needed in the interface, therefor we
-          will use the global symtable. Programs don't have a globalsymtable and there we
-          use the localsymtable }
-        if current_module.is_unit then
-          specializest:=current_module.globalsymtable
-        else
-          specializest:=current_module.localsymtable;
-
-        { Can we reuse an already specialized type? }
-        if not assigned(tt) then
-          begin
-            srsym:=tsym(specializest.find(uspecializename));
-            if assigned(srsym) then
-              begin
-                if srsym.typ<>typesym then
-                  internalerror(200710171);
-                tt:=ttypesym(srsym).typedef;
-              end;
-          end;
-
-        if not assigned(tt) then
-          begin
-            { Setup symtablestack at definition time
-              to get types right, however this is not perfect, we should probably record
-              the resolved symbols }
-            oldsymtablestack:=symtablestack;
-            oldextendeddefs:=current_module.extendeddefs;
-            current_module.extendeddefs:=TFPHashObjectList.create(true);
-            symtablestack:=tdefawaresymtablestack.create;
-            if not assigned(genericdef) then
-              internalerror(200705151);
-            hmodule:=find_module_from_symtable(genericdef.owner);
-            if hmodule=nil then
-              internalerror(200705152);
-            pu:=tused_unit(hmodule.used_units.first);
-            while assigned(pu) do
-              begin
-                if not assigned(pu.u.globalsymtable) then
-                  internalerror(200705153);
-                symtablestack.push(pu.u.globalsymtable);
-                pu:=tused_unit(pu.next);
-              end;
-
-            if assigned(hmodule.globalsymtable) then
-              symtablestack.push(hmodule.globalsymtable);
-
-            { hacky, but necessary to insert the newly generated class properly }
-            item:=oldsymtablestack.stack;
-            while assigned(item) and (item^.symtable.symtablelevel>main_program_level) do
-              item:=item^.next;
-            if assigned(item) and (item^.symtable<>symtablestack.top) then
-              symtablestack.push(item^.symtable);
-
-            { Reparse the original type definition }
-            if not err then
-              begin
-                { First a new typesym so we can reuse this specialization and
-                  references to this specialization can be handled }
-                srsym:=ttypesym.create(specializename,generrordef);
-                specializest.insert(srsym);
-
-                if not assigned(genericdef.generictokenbuf) then
-                  internalerror(200511171);
-                current_scanner.startreplaytokens(genericdef.generictokenbuf);
-                read_named_type(tt,specializename,genericdef,generictypelist,false);
-                ttypesym(srsym).typedef:=tt;
-                tt.typesym:=srsym;
-
-                case tt.typ of
-                  { Build VMT indexes for classes }
-                  objectdef:
-                    begin
-                      vmtbuilder:=TVMTBuilder.Create(tobjectdef(tt));
-                      vmtbuilder.generate_vmt;
-                      vmtbuilder.free;
-                    end;
-                  { handle params, calling convention, etc }
-                  procvardef:
-                    begin
-                      if not check_proc_directive(true) then
-                        begin
-                          try_consume_hintdirective(ttypesym(srsym).symoptions,ttypesym(srsym).deprecatedmsg);
-                          consume(_SEMICOLON);
-                        end;
-                      parse_var_proc_directives(ttypesym(srsym));
-                      handle_calling_convention(tprocvardef(tt));
-                      if try_consume_hintdirective(ttypesym(srsym).symoptions,ttypesym(srsym).deprecatedmsg) then
-                        consume(_SEMICOLON);
-                    end;
-                end;
-                { Consume the semicolon if it is also recorded }
-                try_to_consume(_SEMICOLON);
-              end;
-
-            { Restore symtablestack }
-            current_module.extendeddefs.free;
-            current_module.extendeddefs:=oldextendeddefs;
-            symtablestack.free;
-            symtablestack:=oldsymtablestack;
-          end
-        else
-          begin
-            { There is comment few lines before ie 200512115
-              saying "We are parsing the same objectdef, the def index numbers
-              are the same". This is wrong (index numbers are not same)
-              in case there is specialization (S2 in this case) inside
-              specialized generic (G2 in this case) which is equal to
-              some previous specialization (S1 in this case). In that case,
-              new symbol is not added to currently specialized type
-              (S in this case) for that specializations (S2 in this case),
-              and this results in that specialization and generic definition
-              don't have same number of elements in their object symbol tables.
-              This patch adds undefined def to ensure that those
-              two symbol tables will have same number of elements.
-            }
-            tundefineddef.create;
-          end;
-
-        genericdeflist.free;
-        generictypelist.free;
-        if not try_to_consume(_GT) then
-          consume(_RSHARPBRACKET);
-      end;
-
-
     procedure id_type(var def : tdef;isforwarddef,checkcurrentrecdef,allowgenericsyms:boolean); forward;
 
     { def is the outermost type in which other types have to be searched