freepascal.compiler/compiler/pgenutil.pas

{
    Copyright (c) 2011

    Contains different functions that are used in the context of
    parsing generics.

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

 ****************************************************************************
}
unit pgenutil;

{$i fpcdefs.inc}

interface

uses
  { common }
  cclasses,
  { global }
  globtype,
  { parser }
  pgentype,
  { node }
  node,
  { symtable }
  symtype,symdef,symbase;

    procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;const _prettyname:string;parsedtype:tdef;const symname:string;parsedpos:tfileposinfo);inline;
    procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;const _prettyname:string);inline;
    function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef):tdef;inline;
    function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;const symname:string;symtable:tsymtable):tdef;inline;
    function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;parsedtype:tdef;const symname:string;symtable:tsymtable;parsedpos:tfileposinfo):tdef;
    function generate_specialization_phase2(context:tspecializationcontext;genericdef:tstoreddef;parse_class_parent:boolean;const _prettyname:ansistring):tdef;
    function check_generic_constraints(genericdef:tstoreddef;paramlist:tfpobjectlist;poslist:tfplist):boolean;
    function parse_generic_parameters(allowconstraints:boolean):tfphashobjectlist;
    function parse_generic_specialization_types(paramlist:tfpobjectlist;poslist:tfplist;out prettyname,specializename:ansistring):boolean;
    procedure insert_generic_parameter_types(def:tstoreddef;genericdef:tstoreddef;genericlist:tfphashobjectlist;isfwd:boolean);
    procedure maybe_insert_generic_rename_symbol(const name:tidstring;genericlist:tfphashobjectlist);
    function generate_generic_name(const name:tidstring;const specializename:ansistring;const owner_hierarchy:string):tidstring;
    procedure split_generic_name(const name:tidstring;out nongeneric:string;out count:longint);
    procedure add_generic_dummysym(sym:tsym);
    function resolve_generic_dummysym(const name:tidstring):tsym;
    function could_be_generic(const name:tidstring):boolean;inline;
    function try_implicit_specialization(sym:tsym;para:tnode;pdoverloadlist:tfpobjectlist;var unnamed_syms:tfplist;var first_procsym:tsym;var hasoverload:boolean):boolean;
    function finalize_specialization(var pd:tprocdef;spezcontext:tspecializationcontext):boolean;

    procedure generate_specialization_procs;
    procedure generate_specializations_for_forwarddef(def:tdef);
    procedure maybe_add_pending_specialization(def:tdef;unnamed_syms:tfplist);
    function determine_generic_def(const name:tidstring):tstoreddef;

    procedure specialization_init(genericdef:tdef;var state:tspecializationstate);
    procedure specialization_done(var state:tspecializationstate);

implementation

uses
  { common }
  cutils,fpchash,
  { global }
  globals,tokens,verbose,finput,constexp,
  { symtable }
  symconst,symsym,symtable,defcmp,defutil,procinfo,
  { modules }
  fmodule,
  { node }
  nobj,ncon,ncal,
  { parser }
  scanner,
  pbase,pexpr,pdecsub,ptype,psub,pparautl,pdecl;

  type
    tdeftypeset = set of tdeftyp;
  const
    tgeneric_param_const_types : tdeftypeset = [orddef,stringdef,floatdef,setdef,pointerdef,enumdef];
    tgeneric_param_nodes : tnodetypeset = [typen,ordconstn,stringconstn,realconstn,setconstn,niln];

    procedure make_prettystring(paramtype:tdef;first:boolean;constprettyname:ansistring;var prettyname,specializename:ansistring);
      var
        namepart : string;
        prettynamepart : ansistring;
        module : tmodule;
      begin
        module:=find_module_from_symtable(paramtype.owner);
        if not assigned(module) then
          internalerror(2016112802);
        namepart:='_$'+hexstr(module.moduleid,8)+'$$'+paramtype.unique_id_str;
        { we use the full name of the type to uniquely identify it }
        if (symtablestack.top.symtabletype=parasymtable) and
            (symtablestack.top.defowner.typ=procdef) and
            (paramtype.owner=symtablestack.top) then
          begin
            { special handling for specializations inside generic function declarations }
            prettynamepart:=tdef(symtablestack.top.defowner).fullownerhierarchyname(true)+tprocdef(symtablestack.top.defowner).procsym.prettyname;
          end
        else
          begin
            prettynamepart:=paramtype.fullownerhierarchyname(true);
          end;
        specializename:=specializename+namepart;
        if not first then
          prettyname:=prettyname+',';
        if constprettyname<>'' then
          prettyname:=prettyname+constprettyname
        else
          prettyname:=prettyname+prettynamepart+paramtype.typesym.prettyname;
      end;

    function get_generic_param_def(sym:tsym):tdef;
      begin
        if sym.typ=constsym then
          result:=tconstsym(sym).constdef
        else
          result:=ttypesym(sym).typedef;
      end;

    function compare_orddef_by_range(param1,param2:torddef;value:tconstvalue):boolean;
      begin
        if (value.valueord<param2.low) or (value.valueord>param2.high) then
          result:=false
        else
          result:=true;
      end;

    function compare_generic_params(param1,param2:tdef;constparamsym:tconstsym):boolean;
      begin
        if (param1.typ=orddef) and (param2.typ=orddef) then
          begin
            if is_boolean(param2) then
              result:=is_boolean(param1)
            else if is_char(param2) then
              result:=is_char(param1)
            else if compare_orddef_by_range(torddef(param1),torddef(param2),constparamsym.value) then
              result:=true
            else
              result:=false;
          end
        { arraydef is string constant so it's compatible with stringdef }
        else if (param1.typ=arraydef) and (param2.typ=stringdef) then
          result:=true
        { integer ords are compatible with float }
        else if (param1.typ=orddef) and is_integer(param1) and (param2.typ=floatdef) then
          result:=true
        { chars are compatible with stringdef }
        else if (param1.typ=orddef) and is_char(param1) and (param2.typ=stringdef) then
          result:=true
        { undefined def is compatible with all types }
        else if param2.typ=undefineddef then
          result:=true
        { sets require stricter checks }
        else if is_set(param2) then
          result:=equal_defs(param1,param2)
        else
          result:=param1.typ=param2.typ;
      end;

    function create_generic_constsym(fromdef:tdef;node:tnode;out prettyname:string):tconstsym;
      const
        undefinedname = 'undefined';
      var
        sym : tconstsym;
        setdef : tsetdef;
        enumsym : tsym;
        enumname : string;
        sp : pchar;
        ps : ^tconstset;
        pd : ^bestreal;
        i : integer;
      begin
        if node=nil then
          internalerror(2020011401);
        case node.nodetype of
          ordconstn:
            begin
              sym:=cconstsym.create_ord(undefinedname,constord,tordconstnode(node).value,fromdef);
              prettyname:=tostr(tordconstnode(node).value.svalue);
            end;
          stringconstn:
            begin
              getmem(sp,tstringconstnode(node).len+1);
              move(tstringconstnode(node).value_str^,sp^,tstringconstnode(node).len+1);
              sym:=cconstsym.create_string(undefinedname,conststring,sp,tstringconstnode(node).len,fromdef);
              prettyname:=''''+tstringconstnode(node).value_str+'''';
            end;
          realconstn:
            begin
              new(pd);
              pd^:=trealconstnode(node).value_real;
              sym:=cconstsym.create_ptr(undefinedname,constreal,pd,fromdef);
              prettyname:=realtostr(trealconstnode(node).value_real);
            end;
          setconstn:
            begin
              new(ps);
              ps^:=tsetconstnode(node).value_set^;
              sym:=cconstsym.create_ptr(undefinedname,constset,ps,fromdef);
              setdef:=tsetdef(tsetconstnode(node).resultdef);
              prettyname:='[';
              for i := setdef.setbase to setdef.setmax do
                if i in tsetconstnode(node).value_set^ then
                  begin
                    if setdef.elementdef.typ=enumdef then
                      enumsym:=tenumdef(setdef.elementdef).int2enumsym(i)
                    else
                      enumsym:=nil;
                    if assigned(enumsym) then
                      enumname:=enumsym.realname
                    else if setdef.elementdef.typ=orddef then
                      begin
                        if torddef(setdef.elementdef).ordtype=uchar then
                          enumname:=chr(i)
                        else
                          enumname:=tostr(i);
                      end
                    else
                      enumname:=tostr(i);
                    if length(prettyname) > 1 then
                      prettyname:=prettyname+','+enumname
                    else
                      prettyname:=prettyname+enumname;
                  end;
              prettyname:=prettyname+']';
            end;
          niln:
            begin
              { only "nil" is available for pointer constants }
              sym:=cconstsym.create_ord(undefinedname,constnil,0,fromdef);
              prettyname:='nil';
            end;
          else
            internalerror(2019021601);
        end;
        { the sym needs an owner for later checks so use the typeparam owner }
        sym.owner:=fromdef.owner;
        include(sym.symoptions,sp_generic_const);
        result:=sym;
      end;

    procedure maybe_add_waiting_unit(tt:tdef);
      var
        hmodule : tmodule;
      begin
        if not assigned(tt) or
            not (df_generic in tt.defoptions) then
          exit;

        hmodule:=find_module_from_symtable(tt.owner);
        if not assigned(hmodule) then
          internalerror(2012092401);

        if hmodule=current_module then
          exit;

        if hmodule.state<>ms_compiled then
          begin
{$ifdef DEBUG_UNITWAITING}
            Writeln('Unit ', current_module.modulename^,
              ' waiting for ', hmodule.modulename^);
{$endif DEBUG_UNITWAITING}
            if current_module.waitingforunit.indexof(hmodule)<0 then
              current_module.waitingforunit.add(hmodule);
            if hmodule.waitingunits.indexof(current_module)<0 then
              hmodule.waitingunits.add(current_module);
          end;
      end;


    procedure add_forward_generic_def(def:tdef;context:tspecializationcontext);
      var
        list : tfpobjectlist;
        fwdcontext : tspecializationcontext;
      begin
        if not is_implicit_pointer_object_type(def) then
          internalerror(2020070301);
        if not (oo_is_forward in tobjectdef(def).objectoptions) then
          internalerror(2020070302);
        if not assigned(tobjectdef(def).genericdef) then
          internalerror(2020070303);
        list:=tfpobjectlist(current_module.forwardgenericdefs.find(tobjectdef(def).genericdef.fulltypename));
        if not assigned(list) then
          begin
            list:=tfpobjectlist.create(true);
            current_module.forwardgenericdefs.add(tobjectdef(def).genericdef.fulltypename,list);
          end;
        fwdcontext:=context.getcopy;
        fwdcontext.forwarddef:=def;
        list.add(fwdcontext);
      end;


    function check_generic_constraints(genericdef:tstoreddef;paramlist:tfpobjectlist;poslist:tfplist):boolean;
      var
        i,j,
        intfcount : longint;
        formaldef,
        paradef : tstoreddef;
        genparadef : tdef;
        objdef,
        paraobjdef,
        formalobjdef : tobjectdef;
        intffound : boolean;
        filepos : tfileposinfo;
        is_const : boolean;
      begin
        { check whether the given specialization parameters fit to the eventual
          constraints of the generic }
        if not assigned(genericdef.genericparas) or (genericdef.genericparas.count=0) then
          internalerror(2012101001);
        if genericdef.genericparas.count<>paramlist.count then
          internalerror(2012101002);
        if paramlist.count<>poslist.count then
          internalerror(2012120801);
        result:=true;
        for i:=0 to genericdef.genericparas.count-1 do
          begin
            filepos:=pfileposinfo(poslist[i])^;
            paradef:=tstoreddef(get_generic_param_def(tsym(paramlist[i])));
            is_const:=tsym(paramlist[i]).typ=constsym;
            genparadef:=genericdef.get_generic_param_def(i);
            { validate const params }
            if not genericdef.is_generic_param_const(i) and is_const then
              begin
                MessagePos(filepos,type_e_mismatch);
                exit(false);
              end
            else if genericdef.is_generic_param_const(i) then
              begin
                { param type mismatch (type <> const) }
                 if genericdef.is_generic_param_const(i)<>is_const then
                   begin
                    MessagePos(filepos,type_e_mismatch);
                    exit(false);
                  end;
                { type constrained param doesn't match type }
                if not compare_generic_params(paradef,genericdef.get_generic_param_def(i),tconstsym(paramlist[i])) then
                  begin
                    MessagePos2(filepos,type_e_incompatible_types,FullTypeName(paradef,genparadef),FullTypeName(genparadef,paradef));
                    exit(false);
                  end;
              end;
            { test constraints for non-const params }
            if not genericdef.is_generic_param_const(i) then
              begin
                formaldef:=tstoreddef(ttypesym(genericdef.genericparas[i]).typedef);
                if formaldef.typ=undefineddef then
                  { the parameter is of unspecified type, so no need to check }
                  continue;
                if not (df_genconstraint in formaldef.defoptions) or
                    not assigned(formaldef.genconstraintdata) then
                  internalerror(2013021602);
                { undefineddef is compatible with anything }
                if formaldef.typ=undefineddef then
                  continue;
                if paradef.typ<>formaldef.typ then
                  begin
                    case formaldef.typ of
                      recorddef:
                        { delphi has own fantasy about record constraint
                          (almost non-nullable/non-nilable value type) }
                        if m_delphi in current_settings.modeswitches then
                          case paradef.typ of
                            floatdef,enumdef,orddef:
                              continue;
                            objectdef:
                              if tobjectdef(paradef).objecttype=odt_object then
                                continue
                              else
                                MessagePos(filepos,type_e_record_type_expected);
                            else
                              MessagePos(filepos,type_e_record_type_expected);
                          end
                        else
                          MessagePos(filepos,type_e_record_type_expected);
                      objectdef:
                        case tobjectdef(formaldef).objecttype of
                          odt_class,
                          odt_javaclass:
                            MessagePos1(filepos,type_e_class_type_expected,paradef.typename);
                          odt_interfacecom,
                          odt_interfacecorba,
                          odt_dispinterface,
                          odt_interfacejava:
                            MessagePos1(filepos,type_e_interface_type_expected,paradef.typename);
                          else
                            internalerror(2012101003);
                        end;
                      errordef:
                        { ignore }
                        ;
                      else
                        internalerror(2012101004);
                    end;
                    result:=false;
                  end
                else
                  begin
                    { the paradef types are the same, so do special checks for the
                      cases in which they are needed }
                    if formaldef.typ=objectdef then
                      begin
                        paraobjdef:=tobjectdef(paradef);
                        formalobjdef:=tobjectdef(formaldef);
                        if not (formalobjdef.objecttype in [odt_class,odt_javaclass,odt_interfacecom,odt_interfacecorba,odt_interfacejava,odt_dispinterface]) then
                          internalerror(2012101102);
                        if formalobjdef.objecttype in [odt_interfacecom,odt_interfacecorba,odt_interfacejava,odt_dispinterface] then
                          begin
                            { this is either a concerete interface or class type (the
                              latter without specific implemented interfaces) }
                            case paraobjdef.objecttype of
                              odt_interfacecom,
                              odt_interfacecorba,
                              odt_interfacejava,
                              odt_dispinterface:
                                begin
                                  if (oo_is_forward in paraobjdef.objectoptions) and
                                      (paraobjdef.objecttype=formalobjdef.objecttype) and
                                      (df_genconstraint in formalobjdef.defoptions) and
                                      (
                                        (formalobjdef.objecttype=odt_interfacecom) and
                                        (formalobjdef.childof=interface_iunknown)
                                      )
                                      or
                                      (
                                        (formalobjdef.objecttype=odt_interfacecorba) and
                                        (formalobjdef.childof=nil)
                                      ) then
                                    continue;
                                  if not def_is_related(paraobjdef,formalobjdef.childof) then
                                    begin
                                      MessagePos2(filepos,type_e_incompatible_types,paraobjdef.typename,formalobjdef.childof.typename);
                                      result:=false;
                                    end;
                                end;
                              odt_class,
                              odt_javaclass:
                                begin
                                  objdef:=paraobjdef;
                                  intffound:=false;
                                  while assigned(objdef) do
                                    begin
                                      for j:=0 to objdef.implementedinterfaces.count-1 do
                                        if timplementedinterface(objdef.implementedinterfaces[j]).intfdef=formalobjdef.childof then
                                          begin
                                            intffound:=true;
                                            break;
                                          end;
                                      if intffound then
                                        break;
                                      objdef:=objdef.childof;
                                    end;
                                  result:=intffound;
                                  if not result then
                                    MessagePos2(filepos,parser_e_class_doesnt_implement_interface,paraobjdef.typename,formalobjdef.childof.typename);
                                end;
                              else
                                begin
                                  MessagePos1(filepos,type_e_class_or_interface_type_expected,paraobjdef.typename);
                                  result:=false;
                                end;
                            end;
                          end
                        else
                          begin
                            { this is either a "class" or a concrete instance with
                              or without implemented interfaces }
                            if not (paraobjdef.objecttype in [odt_class,odt_javaclass]) then
                              begin
                                MessagePos1(filepos,type_e_class_type_expected,paraobjdef.typename);
                                result:=false;
                                continue;
                              end;
                            { for forward declared classes we allow pure TObject/class declarations }
                            if (oo_is_forward in paraobjdef.objectoptions) and
                                (df_genconstraint in formaldef.defoptions) then
                              begin
                                if (formalobjdef.childof=class_tobject) and
                                    not formalobjdef.implements_any_interfaces then
                                  continue;
                              end;
                            if assigned(formalobjdef.childof) and
                                not def_is_related(paradef,formalobjdef.childof) then
                              begin
                                MessagePos2(filepos,type_e_incompatible_types,paraobjdef.typename,formalobjdef.childof.typename);
                                result:=false;
                              end;
                            intfcount:=0;
                            for j:=0 to formalobjdef.implementedinterfaces.count-1 do
                              begin
                                objdef:=paraobjdef;
                                while assigned(objdef) do
                                  begin
                                    intffound:=assigned(
                                                 find_implemented_interface(objdef,
                                                   timplementedinterface(formalobjdef.implementedinterfaces[j]).intfdef
                                                 )
                                               );
                                    if intffound then
                                      break;
                                    objdef:=objdef.childof;
                                  end;
                                if intffound then
                                  inc(intfcount)
                                else
                                  MessagePos2(filepos,parser_e_class_doesnt_implement_interface,paraobjdef.typename,timplementedinterface(formalobjdef.implementedinterfaces[j]).intfdef.typename);
                              end;
                            if intfcount<>formalobjdef.implementedinterfaces.count then
                              result:=false;
                          end;
                      end;
                  end;
              end;
          end;
      end;

    function parse_generic_specialization_types_internal(paramlist:tfpobjectlist;poslist:tfplist;out prettyname,specializename:ansistring;parsedtype:tdef;parsedpos:tfileposinfo):boolean;
      var
        old_block_type : tblock_type;
        first : boolean;
        typeparam : tnode;
        parampos : pfileposinfo;
        tmpparampos : tfileposinfo;
        namepart : string;
        module : tmodule;
        constprettyname : string;
        validparam : boolean;
      begin
        result:=true;
        prettyname:='';
        constprettyname:='';
        if paramlist=nil then
          internalerror(2012061401);
        { set the block type to type, so that the parsed type are returned as
          ttypenode (e.g. classes are in non type-compatible blocks returned as
          tloadvmtaddrnode) }
        old_block_type:=block_type;
        { if parsedtype is set, then the first type identifer was already parsed
          (happens in inline specializations) and thus we only need to parse
          the remaining types and do as if the first one was already given }
        first:=not assigned(parsedtype);
        if assigned(parsedtype) then
          begin
            paramlist.Add(parsedtype.typesym);
            module:=find_module_from_symtable(parsedtype.owner);
            if not assigned(module) then
              internalerror(2016112801);
            namepart:='_$'+hexstr(module.moduleid,8)+'$$'+parsedtype.unique_id_str;
            specializename:='$'+namepart;
            prettyname:=parsedtype.fullownerhierarchyname(true)+parsedtype.typesym.prettyname;
            if assigned(poslist) then
              begin
                New(parampos);
                parampos^:=parsedpos;
                poslist.add(parampos);
              end;
          end
        else
          specializename:='$';
        while not (token in [_GT,_RSHARPBRACKET]) do
          begin
            { "first" is set to false at the end of the loop! }
            if not first then
              consume(_COMMA);
            block_type:=bt_type;
            tmpparampos:=current_filepos;
            typeparam:=factor(false,[ef_accept_equal]);
            { determine if the typeparam node is a valid type or const }
            validparam:=typeparam.nodetype in tgeneric_param_nodes;
            if validparam then
              begin
                if tstoreddef(typeparam.resultdef).is_generic and
                    (
                      not parse_generic or
                      not defs_belong_to_same_generic(typeparam.resultdef,current_genericdef)
                    ) then
                  Message(parser_e_no_generics_as_params);
                if assigned(poslist) then
                  begin
                    New(parampos);
                    parampos^:=tmpparampos;
                    poslist.add(parampos);
                  end;
                if typeparam.resultdef.typ<>errordef then
                  begin
                    if (typeparam.nodetype=typen) and not assigned(typeparam.resultdef.typesym) then
                      message(type_e_generics_cannot_reference_itself)
                    else if (typeparam.resultdef.typ<>errordef) then
                      begin
                        { all non-type nodes are considered const }
                        if typeparam.nodetype<>typen then
                          paramlist.Add(create_generic_constsym(typeparam.resultdef,typeparam,constprettyname))
                        else
                          begin
                            constprettyname:='';
                            paramlist.Add(typeparam.resultdef.typesym);
                          end;
                        make_prettystring(typeparam.resultdef,first,constprettyname,prettyname,specializename);
                      end;
                  end
                else
                  begin
                    result:=false;
                  end;
              end
            else
              begin
                Message(type_e_type_id_expected);
                result:=false;
              end;
            typeparam.free;
            first:=false;
          end;
        block_type:=old_block_type;
      end;


    function parse_generic_specialization_types(paramlist:tfpobjectlist;poslist:tfplist;out prettyname,specializename:ansistring):boolean;
      var
        dummypos : tfileposinfo;
      begin
        FillChar(dummypos, SizeOf(tfileposinfo), 0);
        result:=parse_generic_specialization_types_internal(paramlist,poslist,prettyname,specializename,nil,dummypos);
      end;


    procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;const _prettyname:string);
      var
        dummypos : tfileposinfo;
      begin
        FillChar(dummypos, SizeOf(tfileposinfo), 0);
        generate_specialization(tt,parse_class_parent,_prettyname,nil,'',dummypos);
      end;


    function finalize_specialization(var pd:tprocdef;spezcontext:tspecializationcontext):boolean;
      var
        def : tdef;
      begin
        result:=false;
        if assigned(spezcontext) then
          begin
            if not (df_generic in pd.defoptions) then
              internalerror(2015060301);
            { check whether the given parameters are compatible
              to the def's constraints }
            if not check_generic_constraints(pd,spezcontext.paramlist,spezcontext.poslist) then
              exit;
            def:=generate_specialization_phase2(spezcontext,pd,false,'');
            case def.typ of
              errordef:
                { do nothing }
                ;
              procdef:
                pd:=tprocdef(def);
              else
                internalerror(2015070303);
            end;
          end;
        result:=true;
      end;


    procedure transfer_unnamed_symbols(owner:tsymtable;unnamed_syms:tfplist);
      var
        i : integer;
        sym : tsym;
      begin
        for i:=0 to unnamed_syms.count-1 do
          begin
            sym:=tsym(unnamed_syms[i]);
            sym.ChangeOwnerAndName(owner.symlist,sym.realname);
          end;
        unnamed_syms.clear;
      end;


    function try_implicit_specialization(sym:tsym;para:tnode;pdoverloadlist:tfpobjectlist;var unnamed_syms:tfplist;var first_procsym:tsym;var hasoverload:boolean):boolean;

      { hash key for generic parameter lookups }
      function generic_param_hash(def:tdef):string;inline;
        begin
          result:=def.typename;
        end;

      { returns true if the def a literal array such as [1,2,3] and not a shortstring }
      function is_array_literal(def:tdef):boolean;
        begin
          result:=(def.typ=arraydef) and not is_conststring_array(def);
        end;

      { makes the specialization context from the generic proc def and generic params }
      procedure generate_implicit_specialization(out context:tspecializationcontext;genericdef:tprocdef;genericparams:tfphashlist);
        var
          parsedpos:tfileposinfo;
          poslist:tfplist;
          i: longint;
          paramtype: ttypesym;
          parampos : pfileposinfo;
          tmpparampos : tfileposinfo;
          paramname: string;
        begin
          context:=tspecializationcontext.create;
          fillchar(parsedpos,sizeof(parsedpos),0);
          poslist:=context.poslist;
          tmpparampos:=current_filepos;
          if genericparams.count<>genericdef.genericparas.count then
            internalerror(2021020901);
          for i:=0 to genericparams.count-1 do
            begin
              paramname:=generic_param_hash(ttypesym(genericdef.genericparas[i]).typedef);
              paramtype:=ttypesym(genericparams.find(paramname));
              if not assigned(paramtype) then
                internalerror(2021020902);
              new(parampos);
              parampos^:=tmpparampos;
              poslist.add(parampos);
              context.paramlist.Add(paramtype);
              make_prettystring(paramtype.typedef,i=0,'',context.prettyname,context.specializename);
            end;
          context.genname:=genericdef.procsym.realname;
        end;

      { specialization context parameter lists require a typesym so we need
        to generate a placeholder for unnamed constant types like
        short strings, open arrays, function pointers etc... }
      function create_unnamed_typesym(def:tdef):tsym;
        var
          newtype: tsym;
        begin
          newtype:=nil;
          if is_conststring_array(def) then
            begin
              { for constant strings we need to respect various modeswitches }
              if (cs_refcountedstrings in current_settings.localswitches) then
                begin
                  if m_default_unicodestring in current_settings.modeswitches then
                    newtype:=cunicodestringtype.typesym
                  else
                    newtype:=cansistringtype.typesym;
                end
              else
                newtype:=cshortstringtype.typesym;
            end
          else if def.typ=stringdef then
            newtype:=tstringdef(def).get_default_string_type.typesym
          else
            begin
              newtype:=ctypesym.create(def.fullownerhierarchyname(false)+typName[def.typ]+'$'+def.unique_id_str,def);
              newtype.owner:=def.owner;
              { ensure that there's no warning }
              newtype.refs:=1;
            end;
          if not assigned(newtype) then
            internalerror(2021020904);
          result:=newtype;
        end;

      { searches for the generic param in specializations }
      function find_param_in_specialization(owner:tprocdef;genericparam:ttypesym;def:tstoreddef):boolean;
        var
          parasym: ttypesym;
          k, i: integer;
        begin
          result:=false;
          for i:=0 to def.genericparas.count-1 do
            begin
              parasym:=ttypesym(def.genericparas[i]);
              { the generic param must have a named typesym }
              if not assigned(parasym.typedef.typesym) then
                internalerror(2021020907);
              { recurse into inline specialization }
              if tstoreddef(parasym.typedef).is_specialization then
                begin
                  result:=find_param_in_specialization(owner,genericparam,tstoreddef(parasym.typedef));
                  if result then
                    exit;
                end
              else if (genericparam=parasym.typedef.typesym) and owner.is_generic_param(parasym.typedef) then
                exit(true);
            end;
        end;

      { searches for the generic param in arrays }
      function find_param_in_array(owner:tprocdef;genericparam:ttypesym;def:tarraydef):boolean;
        var
          elementdef:tstoreddef;
        begin
          elementdef:=tstoreddef(def.elementdef);
          { recurse into multi-dimensional array }
          if elementdef.typ=arraydef then
            result:=find_param_in_array(owner,genericparam,tarraydef(elementdef))
          { something went wrong during parsing and the element is invalid }
          else if elementdef.typ=errordef then
            result:=false
          else
            begin
              { the element must have a named typesym }
              if not assigned(elementdef.typesym) then
                internalerror(2021020906);
              result:=(genericparam=elementdef.typesym) and owner.is_generic_param(elementdef);
            end;
        end;

      { tests if the generic param is used in the parameter list }
      function is_generic_param_used(owner:tprocdef;genericparam:ttypesym;paras:tfplist):boolean;
        var
          paravar:tparavarsym;
          i: integer;
        begin
          result:=false;
          for i:=0 to paras.count-1 do
            begin
              paravar:=tparavarsym(paras[i]);

              { handle array types by using element types (for example: array of T) }
              if paravar.vardef.typ=arraydef then
                result:=find_param_in_array(owner,genericparam,tarraydef(paravar.vardef))
              { for specializations check search in generic params }
              else if tstoreddef(paravar.vardef).is_specialization then
                result:=find_param_in_specialization(owner,genericparam,tstoreddef(paravar.vardef))
              { something went wrong during parsing and the parameter is invalid }
              else if paravar.vardef.typ=errordef then
                exit(false)
              else
                begin
                  if not assigned(paravar.vardef.typesym) then
                    internalerror(2021020905);
                  result:=(genericparam=paravar.vardef.typesym) and owner.is_generic_param(paravar.vardef)
                end;

              { exit if we find a used parameter }
              if result then
                exit;
            end;
        end;

      { handle generic specializations by using generic params from caller
        to specialize the target. for example "TRec<Integer>" can use "Integer"
        to specialize "TRec<T>" with "Integer" for "T". }
      procedure handle_specializations(genericparams:tfphashlist;target_def,caller_def:tstoreddef);
        var
          i,
          index : integer;
          key : string;
          target_param,
          caller_param : ttypesym;
        begin
          { the target and the caller must the same generic def 
            with the same set of generic parameters }
          if target_def.genericdef<>caller_def.genericdef then
            internalerror(2021020909);

          for i:=0 to target_def.genericparas.count-1 do
            begin
              target_param:=ttypesym(target_def.genericparas[i]);
              caller_param:=ttypesym(caller_def.genericparas[i]);

              { reject generics with constants }
              if (target_param.typ=constsym) or (caller_param.typ=constsym) then
                exit;

              key:=generic_param_hash(target_param.typedef);

              { the generic param is already used }
              index:=genericparams.findindexof(key);
              if index>=0 then
                continue;

              { add the type to the generic params }
              genericparams.add(key,caller_param);
            end;
        end;

      { specialize arrays by using element types but arrays may be multi-dimensional 
        so we need to examine the caller/target pairs recursively in order to
        verify the dimensionality is equal }
      function handle_arrays(owner:tprocdef;target_def,caller_def:tarraydef;out target_element,caller_element:tdef):boolean;
        begin
          { the target and the caller are both arrays and the target is a 
            specialization so we can recurse into the targets element def }
          if is_array_literal(target_def.elementdef) and 
            is_array_literal(caller_def.elementdef) and 
            target_def.is_specialization then
            result:=handle_arrays(owner,tarraydef(target_def.elementdef),tarraydef(caller_def.elementdef),target_element,caller_element)
          else
            begin
              { the caller is an array which means the dimensionality is unbalanced
                and thus the arrays are compatible }
              if is_array_literal(caller_def.elementdef) then
                exit(false);
              { if the element is a generic param then return this type
                along with the caller element type at the same level }
              result:=owner.is_generic_param(target_def.elementdef);
              if result then
                begin
                  target_element:=target_def.elementdef;
                  caller_element:=caller_def.elementdef;
                end;
            end;
        end;

      { handle procvars by using the parameters from the caller to specialize
        the parameters of the target generic procedure specialization. for example:

          type generic TProc<S> = procedure(value: S);
          generic procedure Run<T>(proc: specialize TProc<T>);
          procedure DoCallback(value: integer);
          Run(@DoCallback);

        will specialize as Run<integer> because the signature
        of DoCallback() matches TProc<S> so we can specialize "S"
        with "integer", as they are both parameter #1
      }

      function handle_procvars(genericparams:tfphashlist;callerparams:tfplist;target_def:tdef;caller_def:tdef):boolean;
        var
          newparams : tfphashlist;

        procedure handle_generic_param(targetparadef,callerparadef:tdef);
          var
            key : string;
            index : integer;
          begin
            if not assigned(callerparadef.typesym) then
              internalerror(2021020908);

            key:=generic_param_hash(targetparadef);

            { the generic param must not already be used }
            index:=genericparams.findindexof(key);
            if index<0 then
              begin
                { add the type to the list }
                index:=newparams.findindexof(key);
                if index<0 then
                  newparams.add(key,callerparadef.typesym);
              end;
          end;

        var
          i,j : integer;
          paravar : tparavarsym;
          target_proc,
          caller_proc : tprocvardef;
          target_proc_para,
          caller_proc_para : tparavarsym;
          valid_params : integer;
        begin
          result := false;

          target_proc:=tprocvardef(target_def);
          caller_proc:=tprocvardef(caller_def);

          { parameter count must match exactly
            currently default values are not considered }
          if target_proc.paras.count<>caller_proc.paras.count then
            exit;

          { a mixture of functions and procedures is not allowed }
          if (not assigned(target_proc.returndef) or is_void(target_proc.returndef)) xor
              (not assigned(caller_proc.returndef) or is_void(caller_proc.returndef)) then
            exit;

          { reject generics with constants }
          for i:=0 to target_proc.genericdef.genericparas.count-1 do
            if tsym(target_proc.genericdef.genericparas[i]).typ=constsym then
              exit;

          newparams:=tfphashlist.create;
          valid_params:=0;

          for i:=0 to target_proc.paras.count-1 do
            begin
              target_proc_para:=tparavarsym(target_proc.paras[i]);
              caller_proc_para:=tparavarsym(caller_proc.paras[i]);

              { the parameters are not compatible }
              if compare_defs(caller_proc_para.vardef,target_proc_para.vardef,nothingn)=te_incompatible then
                begin
                  newparams.free;
                  exit(false);
                end;

              if sp_generic_para in target_proc_para.vardef.typesym.symoptions then
                begin
                  paravar:=tparavarsym(tprocvardef(target_proc.genericdef).paras[i]);

                  { find the generic param name in the generic def parameters }
                  j:=target_proc.genericdef.genericparas.findindexof(paravar.vardef.typesym.name);

                  handle_generic_param(ttypesym(target_proc.genericparas[j]).typedef,caller_proc_para.vardef);
                end;

              inc(valid_params);
            end;

          if assigned(target_proc.returndef) and not is_void(target_proc.returndef) then
            begin
              { or check for exact? }
              if compare_defs(caller_proc.returndef,target_proc.returndef,nothingn)<te_equal then
                begin
                  newparams.free;
                  exit(false);
                end;

              if sp_generic_para in target_proc.returndef.typesym.symoptions then
                begin
                  handle_generic_param(target_proc.returndef,caller_proc.returndef);
                end;
            end;

          { if the count of valid params matches the target then
            transfer the temporary params to the actual params }
          result:=valid_params=target_proc.paras.count;
          if result then
            for i := 0 to newparams.count-1 do
              genericparams.add(newparams.nameofindex(i),newparams[i]);

          newparams.free;
        end;

      function maybe_inherited_specialization(givendef,desireddef:tstoreddef;out basedef:tstoreddef):boolean;
        begin
          result:=false;
          basedef:=nil;
          if givendef.typ<>objectdef then
            begin
              result:=givendef.is_specialization and (givendef.genericdef=desireddef.genericdef);
              if result then
                basedef:=givendef;
            end
          else
            begin
              while assigned(givendef) do
                begin
                  if givendef.is_specialization and (givendef.genericdef=desireddef.genericdef) then
                    begin
                      basedef:=givendef;
                      result:=true;
                      break;
                    end;

                  givendef:=tobjectdef(givendef).childof;
                end;
            end;
        end;

      { compare generic parameters <T> with call node parameters. }
      function is_possible_specialization(callerparams:tfplist;genericdef:tprocdef;out unnamed_syms:tfplist;out genericparams:tfphashlist):boolean;
        var
          i,j,
          count : integer;
          paravar : tparavarsym;
          base_def : tstoreddef;
          target_def,
          caller_def : tdef;
          target_key : string;
          index : integer;
          paras : tfplist;
          target_element,
          caller_element : tdef;
          required_param_count : integer;
          adef : tarraydef;
        begin
          result:=false;
          paras:=nil;
          genericparams:=nil;
          required_param_count:=0;
          unnamed_syms:=nil;

          { first perform a check to reject generics with constants }
          for i:=0 to genericdef.genericparas.count-1 do
            if tsym(genericdef.genericparas[i]).typ=constsym then
              exit;

          { build list of visible target function parameters }
          paras:=tfplist.create;
          for i:=0 to genericdef.paras.count-1 do
            begin
              paravar:=tparavarsym(genericdef.paras[i]);
              { ignore hidden parameters }
              if vo_is_hidden_para in paravar.varoptions then
                continue;
              paras.add(paravar);

              { const non-default parameters are required }
              if not assigned(paravar.defaultconstsym) then
                inc(required_param_count);
            end;

          { not enough parameters were supplied }
          if callerparams.count<required_param_count then
            begin
              paras.free;
              exit;
            end;

          { check to make sure the generic parameters are all used 
            at least once in the  caller parameters. }
          count:=0;
          for i:=0 to genericdef.genericparas.count-1 do
            if is_generic_param_used(genericdef,ttypesym(genericdef.genericparas[i]),paras) then
              inc(count);

          if count<genericdef.genericparas.count then
            begin
              paras.free;
              exit;
            end;

          genericparams:=tfphashlist.create;
          for i:=0 to callerparams.count-1 do
            begin
              caller_def:=ttypesym(callerparams[i]).typedef;

              { caller parameter exceeded the possible parameters }
              if i=paras.count then
                begin
                  genericparams.free;
                  paras.free;
                  exit;
                end;

              target_def:=tparavarsym(paras[i]).vardef;
              target_key:='';

              { strings are compatible with "array of T" so we 
                need to use the element type for specialization }
              if is_stringlike(caller_def) and
                is_array_literal(target_def) and
                genericdef.is_generic_param(tarraydef(target_def).elementdef) then
                begin
                  target_def:=tarraydef(target_def).elementdef;
                  target_key:=generic_param_hash(target_def);
                  caller_def:=tstringdef(caller_def).get_default_char_type;
                end
              { non-uniform array constructors (i.e. array of const) are not compatible 
                with normal arrays like "array of T" so we reject them }
              else if is_array_literal(target_def) and
                (caller_def.typ=arraydef) and 
                (ado_IsConstructor in tarraydef(caller_def).arrayoptions) and
                (ado_IsArrayOfConst in tarraydef(caller_def).arrayoptions) then
                begin
                  continue;
                end
              { handle generic arrays }
              else if is_array_literal(caller_def) and
                is_array_literal(target_def) and
                handle_arrays(genericdef,tarraydef(target_def),tarraydef(caller_def),target_element,caller_element) then
                begin
                  target_def:=target_element;
                  caller_def:=caller_element;
                  target_key:=generic_param_hash(target_def);
                end
              { handle generic procvars }
              else if (caller_def.typ=procvardef) and 
                (target_def.typ=procvardef) and 
                tprocvardef(target_def).is_specialization and
                handle_procvars(genericparams,callerparams,target_def,caller_def) then
                begin
                  continue;
                end
              { handle specialized objects by taking the base class as the type to specialize }    
              else if is_class_or_object(caller_def) and 
                is_class_or_object(target_def) and
                genericdef.is_generic_param(target_def) then
                begin
                  target_key:=generic_param_hash(target_def);
                  target_def:=tobjectdef(target_def).childof;
                end
              { handle generic specializations }
              else if tstoreddef(target_def).is_specialization and
                maybe_inherited_specialization(tstoreddef(caller_def),tstoreddef(target_def),base_def) then
                begin
                  handle_specializations(genericparams,tstoreddef(target_def),base_def);
                  continue;
                end
              { handle all other generic params }
              else if target_def.typ=undefineddef then
                target_key:=generic_param_hash(target_def);

              { the param doesn't have a generic key which means we don't need to consider it }
              if target_key='' then
                continue;

              { the generic param is already used }
              index:=genericparams.findindexof(target_key);
              if index>=0 then
                continue;

              { the caller type may not have a typesym so we need to create an unnamed one }
              if not assigned(caller_def.typesym) then
                begin
                  sym:=create_unnamed_typesym(caller_def);
                  { add the unnamed sym to the list but only it was allocated manually }
                  if sym.owner=caller_def.owner then
                    begin
                      if not assigned(unnamed_syms) then
                        unnamed_syms:=tfplist.create;
                      unnamed_syms.add(sym);
                    end;
                  genericparams.add(target_key,sym);
                end
              else
                genericparams.add(target_key,caller_def.typesym);
            end;

          { if the parameter counts match then the specialization is possible }
          result:=genericparams.count=genericdef.genericparas.count;

          { cleanup }
          paras.free;
          if not result then
            genericparams.free;
        end;

      { make an ordered list of parameters from the caller }
      function make_param_list(dummysym:tsym;para:tnode;var unnamed_syms:tfplist):tfplist;
        var
          pt : tcallparanode;
          paradef : tdef;
          sym : tsym;
          i : integer;
        begin
          result:=tfplist.create;
          pt:=tcallparanode(para);
          while assigned(pt) do
            begin
              paradef:=pt.paravalue.resultdef;
              { unnamed parameter types can not be specialized }
              if not assigned(paradef.typesym) then
                begin
                  sym:=create_unnamed_typesym(paradef);
                  result.insert(0,sym);
                  { add the unnamed sym to the list but only if it was allocated manually }
                  if sym.owner=paradef.owner then
                    begin
                      if not assigned(unnamed_syms) then
                        unnamed_syms:=tfplist.create;
                      unnamed_syms.add(sym);
                    end;
                end
              else
                result.insert(0,paradef.typesym);
              pt:=tcallparanode(pt.nextpara);
            end;
        end;

      var
        i,j,k : integer;
        srsym : tprocsym;
        callerparams : tfplist;
        pd : tprocdef;
        dummysym : tprocsym;
        genericparams : tfphashlist;
        spezcontext : tspecializationcontext;
        pd_unnamed_syms : tfplist;
      begin
        result:=false;
        spezcontext:=nil;
        genericparams:=nil;
        dummysym:=tprocsym(sym);
        callerparams:=make_param_list(dummysym,para,unnamed_syms);

        { failed to build the parameter list }
        if not assigned(callerparams) then
          exit;

        for i:=0 to dummysym.genprocsymovlds.count-1 do
          begin
            srsym:=tprocsym(dummysym.genprocsymovlds[i]);
            for j:=0 to srsym.ProcdefList.Count-1 do
              begin
                pd:=tprocdef(srsym.ProcdefList[j]);
                if is_possible_specialization(callerparams,pd,pd_unnamed_syms,genericparams) then
                  begin
                    generate_implicit_specialization(spezcontext,pd,genericparams);
                    genericparams.free;
                    { finalize the specialization so it can be added to the list of overloads }
                    if not finalize_specialization(pd,spezcontext) then
                      begin
                        spezcontext.free;
                        continue;
                      end;
                    { handle unnamed syms used by the specialization }
                    if pd_unnamed_syms<>nil then
                      begin
                        transfer_unnamed_symbols(pd.owner,pd_unnamed_syms);
                        pd_unnamed_syms.free;
                      end;
                    pdoverloadlist.add(pd);
                    spezcontext.free;
                    if po_overload in pd.procoptions then
                      hasoverload:=true;
                    { store first procsym found }
                    if not assigned(first_procsym) then
                      first_procsym:=srsym;
                    result:=true;
                  end
                else
                  begin
                    { the specialization was not chosen so clean up any unnamed syms }
                    if pd_unnamed_syms<>nil then
                      begin
                        for k:=0 to pd_unnamed_syms.count-1 do
                          tsym(pd_unnamed_syms[k]).free;
                        pd_unnamed_syms.free;
                      end;
                  end;
              end;
          end;
        callerparams.free;
      end;

    function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef):tdef;
      var
        dummypos : tfileposinfo;
{$push}
{$warn 5036 off}
      begin
        result:=generate_specialization_phase1(context,genericdef,nil,'',nil,dummypos);
      end;
{$pop}


    function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;const symname:string;symtable:tsymtable):tdef;
      var
        dummypos : tfileposinfo;
{$push}
{$warn 5036 off}
      begin
        result:=generate_specialization_phase1(context,genericdef,nil,symname,symtable,dummypos);
      end;
{$pop}


    function generate_specialization_phase1(out context:tspecializationcontext;genericdef:tdef;parsedtype:tdef;const symname:string;symtable:tsymtable;parsedpos:tfileposinfo):tdef;
      var
        found,
        err : boolean;
        i,
        gencount : longint;
        countstr,genname,ugenname : string;
        tmpstack : tfpobjectlist;
        symowner : tsymtable;
      begin
        context:=nil;
        result:=nil;

        { either symname must be given or genericdef needs to be valid }
        if (symname='') and
            (not assigned(genericdef) or
              (
                (genericdef.typ<>procdef) and
                (
                  not assigned(genericdef.typesym) or
                  (genericdef.typesym.typ<>typesym)
                ) and
                (
                  (genericdef.typ<>objectdef) or
                  not (oo_is_forward in tobjectdef(genericdef).objectoptions)
                )
              ) or
              (
                (genericdef.typ=procdef) and
                (
                  not assigned(tprocdef(genericdef).procsym) or
                  (tprocdef(genericdef).procsym.typ<>procsym)
                )
              )
            ) then
          begin
            internalerror(2019112401);
          end;

        if not assigned(parsedtype) and not try_to_consume(_LT) then
          begin
            consume(_LSHARPBRACKET);
            { handle "<>" }
            if (token=_GT) or (token=_RSHARPBRACKET) then
              begin
                Message(type_e_type_id_expected);
                if not try_to_consume(_GT) then
                  try_to_consume(_RSHARPBRACKET);
                result:=generrordef;
                exit;
              end;
          end;

        context:=tspecializationcontext.create;

        { Parse type parameters }
        err:=not parse_generic_specialization_types_internal(context.paramlist,context.poslist,context.prettyname,context.specializename,parsedtype,parsedpos);
        if err then
          begin
            if not try_to_consume(_GT) then
              try_to_consume(_RSHARPBRACKET);
            context.free;
            context:=nil;
            result:=generrordef;
            exit;
          end;

        { use the name of the symbol as procvars return a user friendly version
          of the name }
        if symname='' then
          begin
            if genericdef.typ=procdef then
              genname:=tprocdef(genericdef).procsym.realname
            else if assigned(genericdef.typesym) then
              genname:=ttypesym(genericdef.typesym).realname
            else if (genericdef.typ=objectdef) and (oo_is_forward in tobjectdef(genericdef).objectoptions) then
              genname:=tobjectdef(genericdef).objrealname^
            else
              internalerror(2020071201);
          end
        else
          genname:=symname;

        { in case of non-Delphi mode the type name could already be a generic
          def (but maybe the wrong one) }
        if assigned(genericdef) and
            ([df_generic,df_specialization]*genericdef.defoptions<>[]) then
          begin
            { remove the type count suffix from the generic's name }
            for i:=Length(genname) downto 1 do
              if genname[i]='$' then
                begin
                  genname:=copy(genname,1,i-1);
                  break;
                end;
            { in case of a specialization we've only reached the specialization
              checksum yet }
            if df_specialization in genericdef.defoptions then
              for i:=length(genname) downto 1 do
                if genname[i]='$' then
                  begin
                    genname:=copy(genname,1,i-1);
                    break;
                  end;
          end
        else
          begin
            split_generic_name(genname,ugenname,gencount);
            if genname<>ugenname then
              genname:=ugenname;
          end;

        { search a generic with the given count of params }
        countstr:='';
        str(context.paramlist.Count,countstr);

        genname:=genname+'$'+countstr;
        ugenname:=upper(genname);

        context.genname:=genname;

        if assigned(genericdef) then
          symowner:=genericdef.owner
        else
          symowner:=symtable;

        if assigned(symowner) and (symowner.symtabletype in [objectsymtable,recordsymtable]) then
          begin
            if symowner.symtabletype = objectsymtable then
              found:=searchsym_in_class(tobjectdef(symowner.defowner),tobjectdef(symowner.defowner),ugenname,context.sym,context.symtable,[])
            else
              found:=searchsym_in_record(tabstractrecorddef(symowner.defowner),ugenname,context.sym,context.symtable);
            if not found then
              found:=searchsym(ugenname,context.sym,context.symtable);
          end
        else
          found:=searchsym(ugenname,context.sym,context.symtable);

        if found and (context.sym.typ=absolutevarsym) and
            (vo_is_funcret in tabstractvarsym(context.sym).varoptions) then
          begin
            { we found the function result alias of a generic function; go up the
              symbol stack *before* this alias was inserted, so that we can
              (hopefully) find the correct generic symbol }
            tmpstack:=tfpobjectlist.create(false);
            while assigned(symtablestack.top) do
              begin
                tmpstack.Add(symtablestack.top);
                symtablestack.pop(symtablestack.top);
                if tmpstack.Last=context.symtable then
                  break;
              end;
            if not assigned(symtablestack.top) then
              internalerror(2019123001);
            found:=searchsym(ugenname,context.sym,context.symtable);
            for i:=tmpstack.count-1 downto 0 do
              symtablestack.push(tsymtable(tmpstack[i]));
            tmpstack.free;
          end;

        if not found or not (context.sym.typ in [typesym,procsym]) then
          begin
            identifier_not_found(genname);
            if not try_to_consume(_GT) then
              try_to_consume(_RSHARPBRACKET);
            context.free;
            context:=nil;
            result:=generrordef;
            exit;
          end;

        { we've found the correct def }
        if context.sym.typ=typesym then
          result:=tstoreddef(ttypesym(context.sym).typedef)
        else
          begin
            if tprocsym(context.sym).procdeflist.count=0 then
              internalerror(2015061203);
            result:=tstoreddef(tprocsym(context.sym).procdefList[0]);
          end;

        if not try_to_consume(_GT) then
          consume(_RSHARPBRACKET);
      end;

    function generate_specialization_phase2(context:tspecializationcontext;genericdef:tstoreddef;parse_class_parent:boolean;const _prettyname:ansistring):tdef;

        procedure unset_forwarddef(def: tdef);
          var
            st : TSymtable;
            i : longint;
          begin
            case def.typ of
              procdef:
                tprocdef(def).forwarddef:=false;
              objectdef,
              recorddef:
                begin
                  st:=def.getsymtable(gs_record);
                  for i:=0 to st.deflist.count-1 do
                    unset_forwarddef(tdef(st.deflist[i]));
                end;
              else
                ;
            end;
          end;

        procedure retrieve_genericdef_or_procsym(sym:tsym;out gendef:tdef;out psym:tsym);
          var
            i : longint;
          begin
            gendef:=nil;
            psym:=nil;
            case sym.typ of
              typesym:
                begin
                  gendef:=ttypesym(sym).typedef
                end;
              procsym:
                begin
                  for i:=0 to tprocsym(sym).procdeflist.count-1 do
                    if tstoreddef(tprocsym(sym).procdeflist[i]).genericdef=genericdef then
                      begin
                        gendef:=tdef(tprocsym(sym).procdeflist[i]);
                        break;
                      end;
                  psym:=sym;
                end
              else
                internalerror(200710171);
            end;
          end;

      var
        finalspecializename,
        ufinalspecializename : tidstring;
        prettyname : ansistring;
        generictypelist : tfphashobjectlist;
        srsymtable,
        specializest : tsymtable;
        hashedid : thashedidstring;
        tempst : tglobalsymtable;
        tsrsym : ttypesym;
        psym,
        srsym : tsym;
        paramdef1,
        paramdef2,
        def : tdef;
        old_block_type : tblock_type;
        state : tspecializationstate;
        old_current_structdef : tabstractrecorddef;
        old_current_specializedef,
        old_current_genericdef : tstoreddef;
        old_current_procinfo : tprocinfo;
        old_module_procinfo : tobject;
        hmodule : tmodule;
        oldcurrent_filepos : tfileposinfo;
        recordbuf : tdynamicarray;
        hadtypetoken : boolean;
        i,
        replaydepth : longint;
        item : tobject;
        allequal,
        hintsprocessed : boolean;
        pd : tprocdef;
        pdflags : tpdflags;
      begin
        if not assigned(context) then
          internalerror(2015052203);

        result:=nil;

        pd:=nil;

        if not check_generic_constraints(genericdef,context.paramlist,context.poslist) then
          begin
            { the parameters didn't fit the constraints, so don't continue with the
              specialization }
            result:=generrordef;
            exit;
          end;

        { build the new type's name }
        finalspecializename:=generate_generic_name(context.genname,context.specializename,genericdef.ownerhierarchyname);
        ufinalspecializename:=upper(finalspecializename);
        if genericdef.typ=procdef then
          prettyname:=tprocdef(genericdef).procsym.prettyname
        else
          prettyname:=genericdef.typesym.prettyname;
        prettyname:=prettyname+'<'+context.prettyname+'>';
        generictypelist:=tfphashobjectlist.create(false);

        { build the list containing the types for the generic params }
        if not assigned(genericdef.genericparas) then
          internalerror(2013092601);
        if context.paramlist.count<>genericdef.genericparas.count then
          internalerror(2013092603);
        for i:=0 to genericdef.genericparas.Count-1 do
          begin
            srsym:=tsym(genericdef.genericparas[i]);
            if not (sp_generic_para in srsym.symoptions) then
              internalerror(2013092602);
            generictypelist.add(srsym.realname,context.paramlist[i]);
          end;

        { Special case if we are referencing the current defined object }
        if assigned(current_structdef) and
           (current_structdef.objname^=ufinalspecializename) then
          result:=current_structdef;

        { Can we reuse an already specialized type? }

        { for this first check whether we are currently specializing a nested
          type of the current (main) specialization (this is necessary, because
          during that time the symbol of the main specialization will still
          contain a reference to an errordef) }
        if not assigned(result) and assigned(current_specializedef) then
          begin
            def:=current_specializedef;
            repeat
              if def.typ in [objectdef,recorddef] then
                if tabstractrecorddef(def).objname^=ufinalspecializename then begin
                  result:=def;
                  break;
                end;
              if assigned(def.owner) then
                def:=tstoreddef(def.owner.defowner)
              else
                { this can happen when specializing a generic function }
                def:=nil;
            until not assigned(def) or not (df_specialization in def.defoptions);
          end;

        { if the genericdef is the def we are currently parsing (or one of its parents) then we can
          not use it for specializing as the tokenbuffer is not yet set (and we aren't done with
          parsing anyway), so for now we treat those still as generic defs without doing a partial
          specialization }
        if not assigned(result) then
          begin
            def:=current_genericdef;
            while assigned(def) and (def.typ in [recorddef,objectdef]) do
              begin
                if (df_generic in def.defoptions) and (def=genericdef) then
                  begin
                    result:=def;
                    break;
                  end;
                { the following happens when a routine with its parent struct
                  as parameter is specialized as a parameter or result of a
                  generic function }
                if (df_specialization in def.defoptions) and (tstoreddef(def).genericdef=genericdef) then
                  begin
                    if tstoreddef(def).genericparas.count=generictypelist.count then
                      begin
                        allequal:=true;
                        for i:=0 to generictypelist.count-1 do
                          begin
                            if tsym(generictypelist[i]).typ<>tsym(tstoreddef(def).genericparas[i]).typ then
                              begin
                                allequal:=false;
                                break;
                              end;
                            if tsym(generictypelist[i]).typ=constsym then
                              paramdef1:=tconstsym(generictypelist[i]).constdef
                            else
                              paramdef1:=ttypesym(generictypelist[i]).typedef;
                            if tsym(tstoreddef(def).genericparas[i]).typ=constsym then
                              paramdef2:=tconstsym(tstoreddef(def).genericparas[i]).constdef
                            else
                              paramdef2:=ttypesym(tstoreddef(def).genericparas[i]).typedef;
                            if not equal_defs(paramdef1,paramdef2) then
                              begin
                                allequal:=false;
                                break;
                              end;
                            if (tsym(generictypelist[i]).typ=constsym) and
                                (
                                  (tconstsym(generictypelist[i]).consttyp<>tconstsym(tstoreddef(def).genericparas[i]).consttyp) or
                                  not same_constvalue(tconstsym(generictypelist[i]).consttyp,tconstsym(generictypelist[i]).value,tconstsym(tstoreddef(def).genericparas[i]).value)
                                ) then
                                begin
                                  allequal:=false;
                                  break;
                                end;
                          end;
                        if allequal then
                          begin
                            result:=def;
                            break;
                          end;
                      end;
                  end;
                def:=tstoreddef(def.owner.defowner);
              end;
          end;

        { decide in which symtable to put the specialization }
        if assigned(context.forwarddef) then
          begin
            specializest:=context.forwarddef.owner;
          end
        else if parse_generic and not assigned(result) then
          begin
            srsymtable:=symtablestack.top;
            if (srsymtable.symtabletype in [localsymtable,parasymtable]) and tstoreddef(srsymtable.defowner).is_specialization then
              { if we are currently specializing a routine we need to specialize into
                the routine's local- or parasymtable so that they are correctly
                registered should the specialization be finalized }
              specializest:=srsymtable
            else if assigned(current_procinfo) and (df_generic in current_procinfo.procdef.defoptions) then
              { if we are parsing the definition of a method we specialize into
                the local symtable of it }
              specializest:=current_procinfo.procdef.getsymtable(gs_local)
            else
              begin
                if not assigned(current_genericdef) then
                  internalerror(2014050901);
                { we specialize the partial specialization into the symtable of the currently parsed
                  generic }
                case current_genericdef.typ of
                  procvardef:
                    specializest:=current_genericdef.getsymtable(gs_para);
                  procdef:
                    specializest:=current_genericdef.getsymtable(gs_local);
                  objectdef,
                  recorddef:
                    specializest:=current_genericdef.getsymtable(gs_record);
                  arraydef:
                    specializest:=tarraydef(current_genericdef).symtable;
                  else
                    internalerror(2014050902);
                end;
              end;
          end
        else
          if current_module.is_unit and current_module.in_interface then
            specializest:=current_module.globalsymtable
          else
            specializest:=current_module.localsymtable;
        if not assigned(specializest) then
          internalerror(2014050910);

        { now check whether there is a specialization somewhere else }
        psym:=nil;
        if not assigned(result) then
          begin
            hashedid.id:=ufinalspecializename;

            if (specializest.symtabletype=objectsymtable) and not assigned(context.forwarddef) then
              begin
                { search also in parent classes }
                if not assigned(current_genericdef) or (current_genericdef.typ<>objectdef) then
                  internalerror(2016112901);
                if not searchsym_in_class(tobjectdef(current_genericdef),tobjectdef(current_genericdef),ufinalspecializename,srsym,srsymtable,[]) then
                  srsym:=nil;
              end
            else
              srsym:=tsym(specializest.findwithhash(hashedid));

            if assigned(context.forwarddef) then
              begin
                { just do a few sanity checks }
                if not assigned(srsym) or not (srsym.typ=typesym) then
                  internalerror(2020070306);
                if ttypesym(srsym).typedef<>context.forwarddef then
                  internalerror(2020070307);
              end
            else if assigned(srsym) then
              begin
                retrieve_genericdef_or_procsym(srsym,result,psym);
              end
            else
              { the generic could have been specialized in the globalsymtable
                already, so search there as well }
              if (specializest<>current_module.globalsymtable) and assigned(current_module.globalsymtable) then
                begin
                  srsym:=tsym(current_module.globalsymtable.findwithhash(hashedid));
                  if assigned(srsym) then
                    begin
                      retrieve_genericdef_or_procsym(srsym,result,psym);
                    end;
                end;
          end;

        if not assigned(result) then
          begin
            specialization_init(genericdef,state);

            { push a temporary global symtable so that the specialization is
              added to the correct symtable; this symtable does not contain
              any other symbols, so that the type resolution can not be
              influenced by symbols in the current unit }
            tempst:=tspecializesymtable.create(current_module.modulename^,current_module.moduleid);
            symtablestack.push(tempst);

            { Reparse the original type definition }
              begin
                old_current_specializedef:=nil;
                old_current_genericdef:=nil;
                old_current_structdef:=nil;
                old_current_procinfo:=current_procinfo;
                old_module_procinfo:=current_module.procinfo;

                current_procinfo:=nil;
                current_module.procinfo:=nil;

                if parse_class_parent then
                  begin
                    old_current_structdef:=current_structdef;
                    old_current_genericdef:=current_genericdef;
                    old_current_specializedef:=current_specializedef;

                    if genericdef.owner.symtabletype in [recordsymtable,objectsymtable] then
                      current_structdef:=tabstractrecorddef(genericdef.owner.defowner)
                    else
                      current_structdef:=nil;
                    current_genericdef:=nil;
                    current_specializedef:=nil;
                  end;

                maybe_add_waiting_unit(genericdef);

                { First a new sym so we can reuse this specialization and
                  references to this specialization can be handled }
                if genericdef.typ=procdef then
                  if assigned(psym) then
                    srsym:=psym
                  else
                    srsym:=cprocsym.create(finalspecializename)
                else
                  srsym:=ctypesym.create(finalspecializename,generrordef);
                { insert the symbol only if we don't know already that we have
                  a procsym to add it to and we aren't dealing with a forwarddef }
                if not assigned(psym) and not assigned(context.forwarddef) then
                  specializest.insertsym(srsym);

                { specializations are declarations as such it is the wisest to
                  declare set the blocktype to "type"; otherwise we'll
                  experience unexpected side effects like the addition of
                  classrefdefs if we have a generic that's derived from another
                  generic }
                old_block_type:=block_type;
                block_type:=bt_type;

                if (
                     (genericdef.typ=procdef) and
                     not assigned(tprocdef(genericdef).genericdecltokenbuf)
                   ) or (
                     (genericdef.typ<>procdef) and
                     not assigned(genericdef.generictokenbuf)
                   ) then
                  internalerror(200511171);
                hmodule:=find_module_from_symtable(genericdef.owner);
                if hmodule=nil then
                  internalerror(2012051202);
                oldcurrent_filepos:=current_filepos;
                { use the index the module got from the current compilation process }
                current_filepos.moduleindex:=hmodule.unit_index;
                current_tokenpos:=current_filepos;
                if parse_generic then
                  begin
                    recordbuf:=current_scanner.recordtokenbuf;
                    current_scanner.recordtokenbuf:=nil;
                  end
                else
                  recordbuf:=nil;
                replaydepth:=current_scanner.replay_stack_depth;
                if genericdef.typ=procdef then
                  begin
                    current_scanner.startreplaytokens(tprocdef(genericdef).genericdecltokenbuf,hmodule.change_endian);
                    parse_proc_head(tprocdef(genericdef).struct,tprocdef(genericdef).proctypeoption,false,genericdef,generictypelist,pd);
                    if assigned(pd) then
                      begin
                        if assigned(psym) then
                          pd.procsym:=psym
                        else
                          pd.procsym:=srsym;
                        parse_proc_dec_finish(pd,po_classmethod in tprocdef(genericdef).procoptions,tprocdef(genericdef).struct);
                      end;
                    result:=pd;
                  end
                else
                  begin
                    current_scanner.startreplaytokens(genericdef.generictokenbuf,hmodule.change_endian);
                    if assigned(context.forwarddef) then
                      begin
                        tsrsym:=nil;
                        result:=parse_forward_declaration(context.forwarddef.typesym,ufinalspecializename,finalspecializename,genericdef,generictypelist,tsrsym);
                        srsym:=tsrsym;
                      end
                    else
                      begin
                        hadtypetoken:=false;
                        read_named_type(result,srsym,genericdef,generictypelist,false,hadtypetoken);
                        ttypesym(srsym).typedef:=result;
                        result.typesym:=srsym;
                      end;


                    if _prettyname<>'' then
                      ttypesym(result.typesym).fprettyname:=_prettyname
                    else
                      ttypesym(result.typesym).fprettyname:=prettyname;
                  end;
                current_filepos:=oldcurrent_filepos;

                { Note regarding hint directives:
                  There is no need to remove the flags for them from the
                  specialized generic symbol, because hint directives that
                  follow the specialization are handled by the code in
                  pdecl.types_dec and added to the type symbol.
                  E.g.: TFoo = TBar<Blubb> deprecated;
                  Here the symbol TBar$1$Blubb will contain the
                  "sp_hint_deprecated" flag while the TFoo symbol won't.}

                case result.typ of
                  { Build VMT indexes for classes and read hint directives }
                  objectdef:
                    begin
                      if replaydepth>current_scanner.replay_stack_depth then
                        begin
                          try_consume_hintdirective(srsym.symoptions,srsym.deprecatedmsg);
                          if replaydepth>current_scanner.replay_stack_depth then
                            consume(_SEMICOLON);
                        end;

                      if oo_is_forward in tobjectdef(result).objectoptions then
                        add_forward_generic_def(result,context)
                      else
                        build_vmt(tobjectdef(result));
                    end;
                  { handle params, calling convention, etc }
                  procvardef:
                    begin
                      hintsprocessed:=false;
                      if replaydepth>current_scanner.replay_stack_depth then
                        begin
                          if not check_proc_directive(true) then
                            begin
                              hintsprocessed:=try_consume_hintdirective(ttypesym(srsym).symoptions,ttypesym(srsym).deprecatedmsg);
                              if replaydepth>current_scanner.replay_stack_depth then
                                consume(_SEMICOLON);
                            end
                          else
                            hintsprocessed:=true;
                        end;
                      if replaydepth>current_scanner.replay_stack_depth then
                        parse_var_proc_directives(ttypesym(srsym));
                      handle_calling_convention(tprocvardef(result),hcc_default_actions_intf);
                      if not hintsprocessed and (replaydepth>current_scanner.replay_stack_depth) then
                        begin
                          try_consume_hintdirective(ttypesym(srsym).symoptions,ttypesym(srsym).deprecatedmsg);
                          if replaydepth>current_scanner.replay_stack_depth then
                            consume(_SEMICOLON);
                        end;
                    end;
                  procdef:
                    begin
                      pdflags:=[];
                      if genericdef.owner.symtabletype=objectsymtable then
                        include(pdflags,pd_object)
                      else if genericdef.owner.symtabletype=recordsymtable then
                        include(pdflags,pd_record);
                      parse_proc_directives(pd,pdflags);
                      while try_consume_hintdirective(pd.symoptions,pd.deprecatedmsg) do
                        consume(_SEMICOLON);
                      if parse_generic then
                        handle_calling_convention(tprocdef(result),hcc_default_actions_intf)
                      else
                        handle_calling_convention(tprocdef(result),hcc_default_actions_impl);
                      pdflags:=pdflags+[pd_body,pd_implemen];
                      proc_add_definition(tprocdef(result));
                      { for partial specializations we implicitely declare the routine as
                        having its implementation although we'll not specialize it in reality }
                      if parse_generic then
                        unset_forwarddef(result);
                    end;
                  else
                    { parse hint directives for records and arrays }
                    if replaydepth>current_scanner.replay_stack_depth then begin
                      try_consume_hintdirective(srsym.symoptions,srsym.deprecatedmsg);
                      if replaydepth>current_scanner.replay_stack_depth then
                        consume(_SEMICOLON);
                    end;
                end;
                { Consume the remainder of the buffer }
                while current_scanner.replay_stack_depth>replaydepth do
                  consume(token);

                if assigned(recordbuf) then
                  begin
                    if assigned(current_scanner.recordtokenbuf) then
                      internalerror(2014050909);
                    current_scanner.recordtokenbuf:=recordbuf;
                  end;

                block_type:=old_block_type;
                current_procinfo:=old_current_procinfo;
                current_module.procinfo:=old_module_procinfo;
                if parse_class_parent then
                  begin
                    current_structdef:=old_current_structdef;
                    current_genericdef:=old_current_genericdef;
                    current_specializedef:=old_current_specializedef;
                  end;
              end;

            { extract all created symbols and defs from the temporary symtable
              and add them to the specializest }
            for i:=tempst.SymList.Count-1 downto 0 do
              begin
                item:=tempst.SymList.Items[i];
                { using changeowner the symbol is automatically added to the
                  new symtable }
                tsym(item).ChangeOwner(specializest);
              end;

            for i:=tempst.DefList.Count-1 downto 0 do
              begin
                item:=tempst.DefList.Items[i];
                { using changeowner the def is automatically added to the new
                  symtable }
                tdef(item).ChangeOwner(specializest);
                { for partial specializations we implicitely declare any methods as having their
                  implementations although we'll not specialize them in reality }
                if parse_generic then
                  unset_forwarddef(tdef(item));
              end;

            { if a generic was declared during the specialization we need to
              flag the specialize symtable accordingly }
            if sto_has_generic in tempst.tableoptions then
              specializest.includeoption(sto_has_generic);

            tempst.free;

            specialization_done(state);

            { procdefs are only added once we know which overload we use }
            if not parse_generic and (result.typ<>procdef) then
              current_module.pendingspecializations.add(result.typename,result);
          end;

        generictypelist.free;
        if assigned(genericdef) then
          begin
            { check the hints of the found generic symbol }
            if genericdef.typ=procdef then
              srsym:=tprocdef(genericdef).procsym
            else
              srsym:=genericdef.typesym;
            check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
          end;
      end;


    procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;const _prettyname:string;parsedtype:tdef;const symname:string;parsedpos:tfileposinfo);
      var
        context : tspecializationcontext;
        genericdef : tstoreddef;
      begin
        genericdef:=tstoreddef(generate_specialization_phase1(context,tt,parsedtype,symname,nil,parsedpos));
        if genericdef<>generrordef then
          genericdef:=tstoreddef(generate_specialization_phase2(context,genericdef,parse_class_parent,_prettyname));
        tt:=genericdef;
        if assigned(context) then
          context.free;
      end;


    function parse_generic_parameters(allowconstraints:boolean):tfphashobjectlist;
      var
        generictype : tstoredsym;
        i,firstidx,const_list_index : longint;
        srsymtable : tsymtable;
        basedef,def : tdef;
        defname : tidstring;
        allowconst,
        allowconstructor,
        is_const,
        doconsume : boolean;
        constraintdata : tgenericconstraintdata;
        old_block_type : tblock_type;
        fileinfo : tfileposinfo;
      begin
        result:=tfphashobjectlist.create(false);
        firstidx:=0;
        const_list_index:=0;
        old_block_type:=block_type;
        block_type:=bt_type;
        allowconst:=true;
        is_const:=false;
        repeat
          if allowconst and try_to_consume(_CONST) then
            begin
              allowconst:=false;
              is_const:=true;
              const_list_index:=result.count;
            end;
          if token=_ID then
            begin
              if is_const then
                generictype:=cconstsym.create_undefined(orgpattern,cundefinedtype)
              else
                generictype:=ctypesym.create(orgpattern,cundefinedtype);
              { type parameters need to be added as strict private }
              generictype.visibility:=vis_strictprivate;
              include(generictype.symoptions,sp_generic_para);
              result.add(orgpattern,generictype);
            end;
          consume(_ID);
          fileinfo:=current_tokenpos;
          { const restriction }
          if is_const and try_to_consume(_COLON) then
            begin
              def:=nil;
              { parse the type and assign the const type to generictype  }
              single_type(def,[]);
              for i:=const_list_index to result.count-1 do
                begin
                  { finalize constant information once type is known }
                  if assigned(def) and (def.typ in tgeneric_param_const_types) then
                    begin
                      case def.typ of
                        orddef,
                        enumdef:
                          tconstsym(result[i]).consttyp:=constord;
                        stringdef:
                          tconstsym(result[i]).consttyp:=conststring;
                        floatdef:
                          tconstsym(result[i]).consttyp:=constreal;
                        setdef:
                          tconstsym(result[i]).consttyp:=constset;
                        { pointer always refers to nil with constants }
                        pointerdef:
                          tconstsym(result[i]).consttyp:=constnil;
                        else
                          internalerror(2020011402);
                      end;
                      tconstsym(result[i]).constdef:=def;
                    end
                  else
                    Message1(type_e_generic_const_type_not_allowed,def.fulltypename);
                end;
              { after type restriction const list terminates }
              is_const:=false;
            end
          { type restriction }
          else if try_to_consume(_COLON) then
            begin
              if not allowconstraints then
                Message(parser_e_generic_constraints_not_allowed_here);
              { construct a name which can be used for a type specification }
              constraintdata:=tgenericconstraintdata.create;
              constraintdata.fileinfo:=fileinfo;
              defname:='';
              str(current_module.deflist.count,defname);
              defname:='$gendef'+defname;

              allowconstructor:=m_delphi in current_settings.modeswitches;

              basedef:=generrordef;
              repeat
                doconsume:=true;

                case token of
                  _CONSTRUCTOR:
                    begin
                      if not allowconstructor or (gcf_constructor in constraintdata.flags) then
                        Message(parser_e_illegal_expression);
                      include(constraintdata.flags,gcf_constructor);
                      allowconstructor:=false;
                    end;
                  _CLASS:
                    begin
                      if gcf_class in constraintdata.flags then
                        Message(parser_e_illegal_expression);
                      if basedef=generrordef then
                        include(constraintdata.flags,gcf_class)
                      else
                        Message(parser_e_illegal_expression);
                    end;
                  _RECORD:
                    begin
                      if ([gcf_constructor,gcf_class]*constraintdata.flags<>[])
                          or (constraintdata.interfaces.count>0) then
                        Message(parser_e_illegal_expression)
                      else
                        begin
                          srsymtable:=trecordsymtable.create(defname,0,1);
                          basedef:=crecorddef.create(defname,srsymtable);
                          include(constraintdata.flags,gcf_record);
                          allowconstructor:=false;
                        end;
                    end;
                  else
                    begin
                      { after single_type "token" is the trailing ",", ";" or
                        ">"! }
                      doconsume:=false;
                      { def is already set to a class or record }
                      if gcf_record in constraintdata.flags then
                        Message(parser_e_illegal_expression);
                      single_type(def, [stoAllowSpecialization]);
                      { only types that are inheritable are allowed }
                      if (def.typ<>objectdef) or
                          not (tobjectdef(def).objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_interfacejava,odt_javaclass]) then
                        Message1(type_e_class_or_interface_type_expected,def.typename)
                      else
                        case tobjectdef(def).objecttype of
                          odt_class,
                          odt_javaclass:
                            begin
                              if gcf_class in constraintdata.flags then
                                { "class" + concrete class is not allowed }
                                Message(parser_e_illegal_expression)
                              else
                                { do we already have a concrete class? }
                                if basedef<>generrordef then
                                  Message(parser_e_illegal_expression)
                                else
                                  basedef:=def;
                            end;
                          odt_interfacecom,
                          odt_interfacecorba,
                          odt_interfacejava,
                          odt_dispinterface:
                            constraintdata.interfaces.add(def);
                          else
                            ;
                        end;
                    end;
                end;
                if doconsume then
                  consume(token);
              until not try_to_consume(_COMMA);

              if ([gcf_class,gcf_constructor]*constraintdata.flags<>[]) or
                  (constraintdata.interfaces.count>1) or
                  (
                    (basedef.typ=objectdef) and
                    (tobjectdef(basedef).objecttype in [odt_javaclass,odt_class])
                  ) then
                begin
                  if basedef.typ=errordef then
                    { don't pass an errordef as a parent to a tobjectdef }
                    basedef:=class_tobject
                  else
                    if (basedef.typ<>objectdef) or
                        not (tobjectdef(basedef).objecttype in [odt_javaclass,odt_class]) then
                      internalerror(2012101101);
                  basedef:=cobjectdef.create(tobjectdef(basedef).objecttype,defname,tobjectdef(basedef),false);
                  for i:=0 to constraintdata.interfaces.count-1 do
                    tobjectdef(basedef).implementedinterfaces.add(
                      timplementedinterface.create(tobjectdef(constraintdata.interfaces[i])));
                end
              else
                if constraintdata.interfaces.count=1 then
                  begin
                    if basedef.typ<>errordef then
                      internalerror(2013021601);
                    def:=tdef(constraintdata.interfaces[0]);
                    basedef:=cobjectdef.create(tobjectdef(def).objecttype,defname,tobjectdef(def),false);
                    constraintdata.interfaces.delete(0);
                  end;

              if basedef.typ<>errordef then
                with tstoreddef(basedef) do
                  begin
                    genconstraintdata:=tgenericconstraintdata.create;
                    genconstraintdata.flags:=constraintdata.flags;
                    genconstraintdata.interfaces.assign(constraintdata.interfaces);
                    genconstraintdata.fileinfo:=constraintdata.fileinfo;
                    include(defoptions,df_genconstraint);
                  end;

              for i:=firstidx to result.count-1 do
                ttypesym(result[i]).typedef:=basedef;
              { we need a typesym in case we do a Delphi-mode inline
                specialization with this parameter; so just use the first sym }
              if not assigned(basedef.typesym) then
                basedef.typesym:=ttypesym(result[firstidx]);
              firstidx:=result.count;

              constraintdata.free;
            end
          else
            begin
              if token=_SEMICOLON then
                begin
                  { two different typeless parameters are considered as incompatible }
                  for i:=firstidx to result.count-1 do
                    if tsym(result[i]).typ<>constsym then
                      begin
                        ttypesym(result[i]).typedef:=cundefineddef.create(false);
                        ttypesym(result[i]).typedef.typesym:=ttypesym(result[i]);
                      end;
                  { a semicolon terminates a type parameter group }
                  firstidx:=result.count;
                end;
            end;
          if token=_SEMICOLON then
            begin
              is_const:=false;
              allowconst:=true;
            end;
        until not (try_to_consume(_COMMA) or try_to_consume(_SEMICOLON));
        { if the constant parameter is not terminated then the type restriction was
          not specified and we need to give an error }
        if is_const then
          consume(_COLON);
        { two different typeless parameters are considered as incompatible }
        for i:=firstidx to result.count-1 do
          if tsym(result[i]).typ<>constsym then
            begin
              ttypesym(result[i]).typedef:=cundefineddef.create(false);
              ttypesym(result[i]).typedef.typesym:=ttypesym(result[i]);
            end;
        block_type:=old_block_type;
      end;


    procedure insert_generic_parameter_types(def:tstoreddef;genericdef:tstoreddef;genericlist:tfphashobjectlist;isfwd:boolean);
      var
        i : longint;
        generictype,
        fwdparam : tstoredsym;
        generictypedef : tdef;
        sym : tsym;
        st : tsymtable;
        fwdok : boolean;
        conv : tconverttype;
        op : tprocdef;
      begin
        def.genericdef:=genericdef;
        if not assigned(genericlist) then
          exit;

        if assigned(genericdef) then
          include(def.defoptions,df_specialization)
        else
          if genericlist.count>0 then
            include(def.defoptions,df_generic);

        case def.typ of
          recorddef,objectdef: st:=tabstractrecorddef(def).symtable;
          arraydef: st:=tarraydef(def).symtable;
          procvardef,procdef: st:=tabstractprocdef(def).parast;
          else
            internalerror(201101020);
        end;

        { if we have a forwarddef we check whether the generic parameters are
          equal and otherwise ignore the list }
        if isfwd then
          begin
            fwdok:=true;
            if (genericlist.count>0) and
                (
                  not assigned(def.genericparas)
                  or (def.genericparas.count<>genericlist.count)
                ) then
              fwdok:=false
            else
              begin
                for i:=0 to genericlist.count-1 do
                  begin
                    if def.genericparas.nameofindex(i)<>genericlist.nameofindex(i) then
                      begin
                        fwdok:=false;
                        break;
                      end;
                    generictype:=tstoredsym(genericlist[i]);
                    fwdparam:=tstoredsym(def.genericparas[i]);
                    op:=nil;
                    conv:=tc_equal;
                    if generictype.typ<>fwdparam.typ then
                      fwdok:=false
                    else if (generictype.typ=typesym) then
                      begin
                        if compare_defs_ext(ttypesym(generictype).typedef,ttypesym(fwdparam).typedef,nothingn,conv,op,[cdo_strict_genconstraint_check])<te_exact then
                          fwdok:=false;
                      end
                    else if (generictype.typ=constsym) then
                      begin
                        if (tconstsym(generictype).consttyp<>tconstsym(fwdparam).consttyp) or
                            (compare_defs_ext(tconstsym(generictype).constdef,tconstsym(fwdparam).constdef,nothingn,conv,op,[cdo_strict_genconstraint_check])<te_exact) then
                          fwdok:=false;
                      end
                    else
                      internalerror(2020070101);

                    if not fwdok then
                      break;
                  end;
              end;

            if not fwdok then
              Message(parser_e_forward_mismatch);

            exit;
          end;

        if (genericlist.count>0) and not assigned(def.genericparas) then
          def.genericparas:=tfphashobjectlist.create(false);
        for i:=0 to genericlist.count-1 do
          begin
            generictype:=tstoredsym(genericlist[i]);
            if assigned(generictype.owner) then
              begin
                if generictype.typ=typesym then
                  sym:=ctypesym.create(genericlist.nameofindex(i),ttypesym(generictype).typedef)
                else if generictype.typ=constsym then
                  { generictype is a constsym that was created in create_generic_constsym
                    during phase 1 so we pass this directly without copying }
                  begin
                    sym:=generictype;
                    { the sym name is still undefined so we set it to match
                      the generic param name so it's accessible }
                    sym.realname:=genericlist.nameofindex(i);
                    include(sym.symoptions,sp_generic_const);
                  end
                else
                  internalerror(2019021602);
                { type parameters need to be added as strict private }
                sym.visibility:=vis_strictprivate;
                st.insertsym(sym);
                include(sym.symoptions,sp_generic_para);
              end
            else
              begin
                if generictype.typ=typesym then
                  begin
                    generictypedef:=ttypesym(generictype).typedef;
                    if (generictypedef.typ=undefineddef) and (generictypedef<>cundefinedtype) then
                      begin
                        { the generic parameters were parsed before the genericdef existed thus the
                          undefineddefs were added as part of the parent symtable }
                        if assigned(generictypedef.owner) then
                          generictypedef.owner.DefList.Extract(generictypedef);
                        generictypedef.changeowner(st);
                      end;
                  end;
                st.insertsym(generictype);
                include(generictype.symoptions,sp_generic_para);
              end;
            def.genericparas.add(genericlist.nameofindex(i),generictype);
          end;
       end;

    procedure maybe_insert_generic_rename_symbol(const name:tidstring;genericlist:tfphashobjectlist);
      var
        gensym : ttypesym;
      begin
        { for generics in non-Delphi modes we insert a private type symbol
          that has the same base name as the currently parsed generic and
          that references this defs }
        if not (m_delphi in current_settings.modeswitches) and
            (
              (
                parse_generic and
                assigned(genericlist) and
                (genericlist.count>0)
              ) or
              (
                assigned(current_specializedef) and
                assigned(current_structdef.genericdef) and
                (current_structdef.genericdef.typ in [objectdef,recorddef]) and
                (pos('$',name)>0)
              )
            ) then
          begin
            { we need to pass nil as def here, because the constructor wants
              to set the typesym of the def which is not what we want }
            gensym:=ctypesym.create(copy(name,1,pos('$',name)-1),nil);
            gensym.typedef:=current_structdef;
            include(gensym.symoptions,sp_internal);
            { the symbol should be only visible to the generic class
              itself }
            gensym.visibility:=vis_strictprivate;
            symtablestack.top.insertsym(gensym);
          end;
      end;

    function generate_generic_name(const name:tidstring;const specializename:ansistring;const owner_hierarchy:string):tidstring;
    var
      crc : cardinal;
    begin
      if specializename='' then
        internalerror(2012061901);
      { build the new type's name }
      crc:=UpdateCrc32(0,specializename[1],length(specializename));
      result:=name+'$crc'+hexstr(crc,8);
      if owner_hierarchy<>'' then
        begin
          crc:=UpdateCrc32(0,owner_hierarchy[1],length(owner_hierarchy));
          result:=result+'$crc'+hexstr(crc,8);
        end;
    end;

    procedure split_generic_name(const name:tidstring;out nongeneric:string;out count:longint);
      var
        i,code : longint;
        countstr : string;
      begin
        for i:=length(name) downto 1 do
          if name[i]='$' then
            begin
              nongeneric:=copy(name,1,i-1);
              countstr:=copy(name,i+1,length(name)-i);
              val(countstr,count,code);
              if code<>0 then
                break;
              exit;
            end;
        nongeneric:=name;
        count:=0;
      end;


    procedure add_generic_dummysym(sym:tsym);
      var
        list: TFPObjectList;
        srsym : tsym;
        srsymtable : tsymtable;
        entry : tgenericdummyentry;
      begin
        if sp_generic_dummy in sym.symoptions then
          begin
            { did we already search for a generic with that name? }
            list:=tfpobjectlist(current_module.genericdummysyms.find(sym.name));
            if not assigned(list) then
              begin
                list:=tfpobjectlist.create(true);
                current_module.genericdummysyms.add(sym.name,list);
              end;
            { is the dummy sym still "dummy"? }
            if (sym.typ=typesym) and
                (
                  { dummy sym defined in mode Delphi }
                  (ttypesym(sym).typedef.typ=undefineddef) or
                  { dummy sym defined in non-Delphi mode }
                  (tstoreddef(ttypesym(sym).typedef).is_generic)
                ) then
              begin
                { do we have a non-generic type of the same name
                  available? }
                if not searchsym_with_flags(sym.name,srsym,srsymtable,[ssf_no_addsymref]) then
                  srsym:=nil;
              end
            else if sym.typ=procsym then
              srsym:=sym
            else
              { dummy symbol is already not so dummy anymore }
              srsym:=nil;
            if assigned(srsym) then
              begin
                entry:=tgenericdummyentry.create;
                entry.resolvedsym:=srsym;
                entry.dummysym:=sym;
                list.add(entry);
              end;
          end;
      end;


    function resolve_generic_dummysym(const name:tidstring):tsym;
      var
        list : tfpobjectlist;
      begin
        list:=tfpobjectlist(current_module.genericdummysyms.find(name));
        if assigned(list) and (list.count>0) then
          result:=tgenericdummyentry(list.last).resolvedsym
        else
          result:=nil;
      end;


    function could_be_generic(const name:tidstring):boolean;
      begin
        result:=(name<>'') and
                  (current_module.genericdummysyms.findindexof(name)>=0);
      end;

    procedure specialization_init(genericdef:tdef;var state: tspecializationstate);
    var
      pu : tused_unit;
      hmodule : tmodule;
      unitsyms : TFPHashObjectList;
      sym : tsym;
      i : Integer;
    begin
      if not assigned(genericdef) then
        internalerror(200705151);
      { Setup symtablestack at definition time
        to get types right, however this is not perfect, we should probably record
        the resolved symbols }
      state.oldsymtablestack:=symtablestack;
      state.oldextendeddefs:=current_module.extendeddefs;
      state.oldgenericdummysyms:=current_module.genericdummysyms;
      current_module.extendeddefs:=TFPHashObjectList.create(true);
      current_module.genericdummysyms:=tfphashobjectlist.create(true);
      symtablestack:=tdefawaresymtablestack.create;
      hmodule:=find_module_from_symtable(genericdef.owner);
      if hmodule=nil then
        internalerror(200705152);
      { collect all unit syms in the generic's unit as we need to establish
        their unitsym.module link again so that unit identifiers can be used }
      unitsyms:=tfphashobjectlist.create(false);
      if (hmodule<>current_module) and assigned(hmodule.globalsymtable) then
        for i:=0 to hmodule.globalsymtable.symlist.count-1 do
          begin
            sym:=tsym(hmodule.globalsymtable.symlist[i]);
            if sym.typ=unitsym then
              unitsyms.add(upper(sym.realname),sym);
          end;
      { add all units if we are specializing inside the current unit (as the
        generic could have been declared in the implementation part), but load
        only interface units, if we are in a different unit as then the generic
        needs to be in the interface section }
      pu:=tused_unit(hmodule.used_units.first);
      while assigned(pu) do
        begin
          if not assigned(pu.u.globalsymtable) then
            { in certain circular, but valid unit constellations it can happen
              that we specialize a generic in a different unit that was used
              in the implementation section of the generic's unit and were the
              interface is still being parsed and thus the localsymtable is in
              reality the global symtable }
            if pu.u.in_interface then
              symtablestack.push(pu.u.localsymtable)
            else
              internalerror(200705153)
          else
            symtablestack.push(pu.u.globalsymtable);
          sym:=tsym(unitsyms.find(pu.u.modulename^));
          if assigned(sym) and not assigned(tunitsym(sym).module) then
            tunitsym(sym).module:=pu.u;
          pu:=tused_unit(pu.next);
        end;
      unitsyms.free;
      if assigned(hmodule.globalsymtable) then
        symtablestack.push(hmodule.globalsymtable);
      { push the localsymtable if needed }
      if ((hmodule<>current_module) or not current_module.in_interface)
          and assigned(hmodule.localsymtable) then
        symtablestack.push(hmodule.localsymtable);
    end;

    procedure specialization_done(var state: tspecializationstate);
    begin
      { Restore symtablestack }
      current_module.extendeddefs.free;
      current_module.extendeddefs:=state.oldextendeddefs;
      current_module.genericdummysyms.free;
      current_module.genericdummysyms:=state.oldgenericdummysyms;
      symtablestack.free;
      symtablestack:=state.oldsymtablestack;
      { clear the state record to be on the safe side }
      fillchar(state, sizeof(state), 0);
    end;


{****************************************************************************
                      SPECIALIZATION BODY GENERATION
****************************************************************************}


    procedure process_procdef(def:tprocdef;hmodule:tmodule);
      var
        oldcurrent_filepos : tfileposinfo;
      begin
        if assigned(def.genericdef) and
            (def.genericdef.typ=procdef) and
            assigned(tprocdef(def.genericdef).generictokenbuf) then
          begin
            if not assigned(tprocdef(def.genericdef).generictokenbuf) then
              internalerror(2015061902);
            oldcurrent_filepos:=current_filepos;
            current_filepos:=tprocdef(def.genericdef).fileinfo;
            { use the index the module got from the current compilation process }
            current_filepos.moduleindex:=hmodule.unit_index;
            current_tokenpos:=current_filepos;
            current_scanner.startreplaytokens(tprocdef(def.genericdef).generictokenbuf,hmodule.change_endian);
            read_proc_body(def);
            current_filepos:=oldcurrent_filepos;
          end
        { synthetic routines will be implemented afterwards }
        else if def.synthetickind=tsk_none then
          MessagePos1(def.fileinfo,sym_e_forward_not_resolved,def.fullprocname(false));
      end;


    function process_abstractrecorddef(def:tabstractrecorddef):boolean;
      var
        i  : longint;
        hp : tdef;
        hmodule : tmodule;
      begin
        result:=true;
        hmodule:=find_module_from_symtable(def.genericdef.owner);
        if hmodule=nil then
          internalerror(201202041);
        for i:=0 to def.symtable.DefList.Count-1 do
          begin
            hp:=tdef(def.symtable.DefList[i]);
            if hp.typ=procdef then
             begin
               { only generate the code if we need a body }
               if assigned(tprocdef(hp).struct) and not tprocdef(hp).forwarddef then
                 continue;
               { and the body is available already (which is implicitely the
                 case if the generic routine is part of another unit) }
               if ((hmodule=current_module) or (hmodule.state=ms_compile)) and
                  { may not be assigned in case it's a synthetic procdef that
                    still needs to be generated }
                  assigned(tprocdef(hp).genericdef) and
                  tprocdef(tprocdef(hp).genericdef).forwarddef then
                 begin
                   result:=false;
                   continue;
                 end;
               process_procdef(tprocdef(hp),hmodule);
             end
           else
             if hp.typ in [objectdef,recorddef] then
               { generate code for subtypes as well }
               result:=process_abstractrecorddef(tabstractrecorddef(hp)) and result;
         end;
      end;


    procedure generate_specialization_procs;
      var
        i : longint;
        list,
        readdlist : tfpobjectlist;
        def : tstoreddef;
        state : tspecializationstate;
        hmodule : tmodule;
      begin
        { first copy all entries and then work with that list to ensure that
          we don't get an infinite recursion }
        list:=tfpobjectlist.create(false);
        readdlist:=tfpobjectlist.create(false);

        for i:=0 to current_module.pendingspecializations.Count-1 do
          list.add(current_module.pendingspecializations.Items[i]);

        current_module.pendingspecializations.clear;

        for i:=0 to list.count-1 do
          begin
            def:=tstoreddef(list[i]);
            if not tstoreddef(def).is_specialization then
              continue;
            case def.typ of
              procdef:
                begin
                  { the use of forwarddef should not backfire as the
                    specialization always belongs to the current module }
                  if not tprocdef(def).forwarddef then
                    continue;
                  if not assigned(def.genericdef) then
                    internalerror(2015061903);
                  hmodule:=find_module_from_symtable(def.genericdef.owner);
                  if hmodule=nil then
                    internalerror(2015061904);
                  { we need to check for a forward declaration only if the
                    generic was declared in the same unit (otherwise there
                    should be one) }
                  if ((hmodule=current_module) or (hmodule.state=ms_compile)) and tprocdef(def.genericdef).forwarddef then
                    begin
                      readdlist.add(def);
                      continue;
                    end;

                  specialization_init(tstoreddef(def).genericdef,state);

                  process_procdef(tprocdef(def),hmodule);

                  specialization_done(state);
                end;
              recorddef,
              objectdef:
                begin
                  specialization_init(tstoreddef(def).genericdef,state);

                  if not process_abstractrecorddef(tabstractrecorddef(def)) then
                    readdlist.add(def);

                  specialization_done(state);
                end;
              else
                ;
            end;
          end;

        { add those defs back to the pending list for which we don't yet have
          all method bodies }
        for i:=0 to readdlist.count-1 do
          current_module.pendingspecializations.add(tstoreddef(readdlist[i]).typename,readdlist[i]);

        readdlist.free;
        list.free;
      end;


    procedure generate_specializations_for_forwarddef(def:tdef);
      var
        list : tfpobjectlist;
        idx,
        i : longint;
        context : tspecializationcontext;
      begin
        if not tstoreddef(def).is_generic then
          internalerror(2020070304);
        idx:=current_module.forwardgenericdefs.findindexof(def.fulltypename);
        if idx<0 then
          exit;
        list:=tfpobjectlist(current_module.forwardgenericdefs.items[idx]);
        if not assigned(list) then
          internalerror(2020070305);
        for i:=0 to list.count-1 do begin
          context:=tspecializationcontext(list[i]);
          generate_specialization_phase2(context,tstoreddef(def),false,'');
        end;
        current_module.forwardgenericdefs.delete(idx);
      end;


    procedure maybe_add_pending_specialization(def:tdef;unnamed_syms: tfplist);
      var
        hmodule : tmodule;
        st : tsymtable;
        i : integer;
      begin
        if parse_generic then
          exit;
        { transfer ownership of any unnamed syms to be the specialization }
        if unnamed_syms<>nil then
          transfer_unnamed_symbols(tprocdef(def).parast,unnamed_syms);
        st:=def.owner;
        while st.symtabletype in [localsymtable] do
          st:=st.defowner.owner;
        hmodule:=find_module_from_symtable(st);
        if tstoreddef(def).is_specialization and (hmodule=current_module) then
          current_module.pendingspecializations.add(def.typename,def);
      end;


    function determine_generic_def(const name:tidstring):tstoreddef;
      var
        hashedid : THashedIDString;
        pd : tprocdef;
        sym : tsym;
      begin
        result:=nil;
        { check whether this is a declaration of a type inside a
          specialization }
        if assigned(current_structdef) and
            (df_specialization in current_structdef.defoptions) then
          begin
            if not assigned(current_structdef.genericdef) or
                not (current_structdef.genericdef.typ in [recorddef,objectdef]) then
              internalerror(2011052301);
            hashedid.id:=name;
            { we could be inside a method of the specialization
              instead of its declaration, so check that first (as
              local nested types aren't allowed we don't need to
              walk the symtablestack to find the localsymtable) }
            if symtablestack.top.symtabletype=localsymtable then
              begin
                { we are in a method }
                if not assigned(symtablestack.top.defowner) or
                    (symtablestack.top.defowner.typ<>procdef) then
                  internalerror(2011120701);
                pd:=tprocdef(symtablestack.top.defowner);
                if not assigned(pd.genericdef) or (pd.genericdef.typ<>procdef) then
                  internalerror(2011120702);
                sym:=tsym(tprocdef(pd.genericdef).localst.findwithhash(hashedid));
              end
            else
              sym:=nil;
            if not assigned(sym) or not (sym.typ=typesym) then
              begin
                { now search in the declaration of the generic }
                sym:=tsym(tabstractrecorddef(current_structdef.genericdef).symtable.findwithhash(hashedid));
                if not assigned(sym) or not (sym.typ=typesym) then
                  internalerror(2011052302);
              end;
            { use the corresponding type in the generic's symtable as
              genericdef for the specialized type }
            result:=tstoreddef(ttypesym(sym).typedef);
          end;
      end;


end.