[fpc-devel] Getting built-in string type

Ryan Joseph ryan at thealchemistguild.com
Thu Feb 28 21:52:26 CET 2019



> On Feb 28, 2019, at 1:44 PM, Sven Barth via fpc-devel <fpc-devel at lists.freepascal.org> wrote:
> 
> Right now I don't remember your changes, but it might be that you're using the wrong approach: You shouldn't need to match anything by yourself as the required infrastructure is already in place. You should extend htypechk (which does the overload resolution) and defcmp (which compares the defs of parameter values and parameter declarations in this case) so that unspecialized generic routines are found (in htypechk) and checked correctly (in defcmp) and then specialized.

Hmmm, I didn’t extend tcallcandidates even though it did get used. Should tcallcandidates be specializing by itself anyways? I thought it was just for overload resolution.

It’s been some months since I looked at this last but this is the function which takes a dummy sym with parsed params and then does a specialization when it finds a match. This looks like a good solution to me except the one issue of strings being arrays instead of the “SHORTSTRING” type.

more at: https://github.com/genericptr/freepascal/tree/generic_implicit

function try_implicit_specialization(sym:tsym;struct:tabstractrecorddef;is_struct_member:boolean;para: tnode;out spezcontext:tspecializationcontext):tdef;
      { insert def to front of list (params are processed in reverse order)
        and only if the param is unique. }
      procedure add_unique_param(list:tfplist;def:tdef);inline;
        begin
          if list.indexof(def)=-1 then
            list.insert(0,def);
        end;
      var
        i, p: integer;
        srsym: tsym;
        srsymtable: TSymtable;
        ignorevisibility,
        allowdefaultparas,
        objcidcall,
        explicitunit,
        searchhelpers,
        anoninherited: boolean;
        count: integer;
        bestpd: tabstractprocdef;
        genname: string;
        candidates: tcallcandidates;
        pt: tcallparanode;
        paraindex: integer;
        paramtypes: tfplist;
      begin
        result:=nil;
        paramtypes:=nil;
        candidates:=nil;
        { count params }
        paraindex:=0;
        pt:=tcallparanode(para);
        while assigned(pt) do
          begin
            pt:=tcallparanode(pt.nextpara);
            paraindex:=paraindex+1;
          end;
        { find generic procsyms by param count, starting from
          number of parsed params. if a procsym is found then
          validate via tcallcandidates and build list of *unique*
          types for use when specializing.
        
          inferred generic types are evaluated by inserting
          non-repating types into the list in linear order.

            (1,'string') = <Integer,String>
            (1,2,3,4,5,6) = <Integer>
            ('a','b') = <String>
            ('string',1) = <String,Integer>
            ('a',1,'b',2,'c') = <String,Integer>
        }
        for i := paraindex downto 1 do
          begin
            genname:=sym.name+'$'+tostr(i);
            if assigned(struct) then
              searchsym_in_struct(struct,is_struct_member,genname,srsym,srsymtable,[ssf_search_helper])
            else
              searchsym(genname,srsym,srsymtable);
            if assigned(srsym) then
              begin
                ignorevisibility:=false;
                allowdefaultparas:=true;
                objcidcall:=false;
                explicitunit:=false;
                searchhelpers:=false;
                anoninherited:=false;
                spezcontext:=nil;
                candidates:=tcallcandidates.create(tprocsym(srsym),srsym.owner,para,ignorevisibility,
                  allowdefaultparas,objcidcall,explicitunit,
                  searchhelpers,anoninherited,spezcontext);
                if candidates.count>0 then
                  begin
                    candidates.get_information;
                    count:=candidates.choose_best(bestpd,false);
                    if count>0 then
                      begin
                        if not assigned(paramtypes) then
                          paramtypes:=tfplist.create;
                        pt:=tcallparanode(para);
                        paraindex:=0;
                        while assigned(pt) do
                          begin
                            case pt.paravalue.nodetype of
                              { types always fail so just block them now }
                              typen:
                                break;
                              { stringconstn resultdef is an arraydef so we need to 
                                find the shortstring type to use as the parameter }
                              stringconstn:
                                begin
                                  // TODO: is there a better way to get the string typesym?
                                  if not searchsym_type('SHORTSTRING',srsym,srsymtable) then
                                    internalerror(2019022603);
                                  add_unique_param(paramtypes,ttypesym(srsym).typedef);
                                end;
                              else
                                add_unique_param(paramtypes,pt.paravalue.resultdef);
                            end;
                            { next parameter in the call tree }
                            pt:=tcallparanode(pt.nextpara);
                            paraindex:=paraindex+1;
                          end;
                        { no params were found }
                        if paramtypes.count=0 then
                          internalerror(2019022601);
                        { parse generic param string based on param types }
                        result:=generate_implicit_specialization(spezcontext,sym.realname,struct,is_struct_member,paramtypes,i);
                        paramtypes.clear;
                        { found a matching proc }
                        if result<>generrordef then
                          break;
                      end;
                  end;
                freeandnil(candidates);
              end;
          end;
        freeandnil(paramtypes);
        freeandnil(candidates);
        if result=nil then
          result:=generrordef;
      end;

    function generate_implicit_specialization(out context:tspecializationcontext;symname:string;struct:tabstractrecorddef;is_struct_member:boolean;paramtypes:tfplist;paracount:integer):tdef;
      var
        parsedpos:tfileposinfo;
        poslist:tfplist;
        found: boolean;
        i: longint;
        ugenname: string;
        paramtype: tdef;
        parampos : pfileposinfo;
        tmpparampos : tfileposinfo;
      begin
        result:=nil;        
        context:=tspecializationcontext.create;
        fillchar(parsedpos,sizeof(parsedpos),0);
        poslist:=context.poslist;
        tmpparampos:=current_filepos;

        { parse_generic_specialization_types_internal }
        for i := 0 to min(paramtypes.count,paracount)-1 do
          begin
            paramtype:=tdef(paramtypes[i]);
            { param type def must have a typesym }
            if not assigned(paramtype.typesym) then
              internalerror(2019022602);
            if assigned(poslist) then
              begin
                new(parampos);
                parampos^:=tmpparampos;
                poslist.add(parampos);
              end;
            context.genericdeflist.Add(paramtype);
            make_prettystring(paramtype,true,context.prettyname,context.specializename);
          end;

        { generate_specialization_phase1 }
        make_genname(context.genericdeflist.Count,symname,nil,context.genname,ugenname);

        if assigned(struct) then
          found:=searchsym_in_struct(struct,is_struct_member,ugenname,context.sym,context.symtable,[ssf_search_helper])
        else
          found:=searchsym(ugenname,context.sym,context.symtable);

        if not found or not (context.sym.typ in [typesym,procsym]) then
          begin
            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;
      end;

Regards,
	Ryan Joseph




More information about the fpc-devel mailing list