het.parser.for.pas

type
  TForType=(ftTo,ftDownTo,ftTowards,ftIn);
  TNodeFor              =class(TNodeManyOp)
  private
    FForType:TForType;
    FDescending:Boolean;
  public
    procedure Eval(var AContext:TContext;var AResult:variant);override;
    function Clone:TNodeBase;override;
  end;

...

procedure TNodeFor.Eval(var AContext: TContext; var AResult: Variant);
var i,j:integer;
    nIndex,nStep,nBlock,nWhere:TNodeBase;
    dest,step,tmp:variant;
    pidx,pset:PVariant;
    worked:boolean;
    ft:TForType;
    s:ansistring;
    o:tobject;

    iStep,iDest:integer;piIdx:pinteger;
    i64Step,i64Dest:int64;pi64Idx:pint64;

    vWhere:variant;

  procedure Iterate;//pidx^ must be set
  begin
    if nWhere<>nil then begin
      nWhere.Eval(AContext,vWhere);
      if not boolean(vWhere) then exit;
    end;
    if nBlock<>nil then
      nBlock.Eval(AContext,AResult);
    worked:=true;
  end;

  var isInt64:boolean;//reset to false
  function VarIsInt(const v:variant):boolean;
  begin with TVarData(v)do begin
    if VType in[varByte,varShortInt,varWord,varSmallint,varInteger]then exit(true);
    if VType in[varLongWord,varInt64]then begin isInt64:=true;exit(true)end;
    result:=false;
  end;end;

begin
  nIndex:=SubNode(0).SubNode(0);
  nStep:=SubNode(2);
  nWhere:=SubNode(3);
  nBlock:=SubNode(4);

  if FForType=ftIn then begin //for in
    pidx:=nIndex.RefPtr(AContext);//ref to index
    pset:=SubNode(0).SubNode(1).RefPtr(AContext,tmp);

    if VarIsObject(pset^) then begin
      o:=VarAsObject(pset^);
      if o=nil then
        ExecError('For-loop: Cannot enumerate NIL object');

      if o is TList then with TList(o)do begin
        if FDescending then for i:=Count-1 downto 0 do begin pidx^:=VObject(TObject(Items[i]));Iterate;end
                       else for i:=0 to Count-1     do begin pidx^:=VObject(TObject(Items[i]));Iterate;end
      end else if o is TComponent then with TComponent(o)do begin
        if FDescending then for i:=ComponentCount-1 downto 0 do begin pidx^:=VObject(Components[i]);Iterate;end
                       else for i:=0 to ComponentCount-1     do begin pidx^:=VObject(Components[i]);Iterate;end
      end else if o is TCollection then with TCollection(o)do begin
        if FDescending then for i:=Count-1 downto 0 do begin pidx^:=VObject(Items[i]);Iterate;end
                       else for i:=0 to Count-1     do begin pidx^:=VObject(Items[i]);Iterate;end
      end else if o is THetObjectList then with THetObjectList(o)do begin
        if FDescending then for i:=Count-1 downto 0 do begin pidx^:=VObject(GetHetObjByIndex(i));Iterate;end
                       else for i:=0 to Count-1     do begin pidx^:=VObject(GetHetObjByIndex(i));Iterate;end;
      end else
        ExecError('For-loop: Cannot enumerate '+toPas(o.ClassName)+' object');

    end else if VarIsStr(pset^)then begin
      s:=ansistring(pset^);
      for i:=1 to length(s)do begin
        pidx^:=s[i];//value
        Iterate;
      end;
    end else if VarIsArray(pset^)then begin
      for i:=VarLow(pset^) to varHigh(pset^)do begin
        pidx^:=VReference(VarArrayAccess(pset^,i));//value
        Iterate;
      end;
    end else if VarIsSet(pset^) then begin
      with VarAsSetArray(pset^)do for j:=0 to Elements.FCount-1 do with Elements.FItems[j]do begin
        if typ=stSingle then begin //single
          pidx^:=VReference(e1);
          Iterate;
        end else if e1<=e2 then begin//range
          pidx^:=e1;

          isInt64:=false;
          if VarIsInt(e1)and VarIsInt(e2)then
            if isInt64 then begin//optimized int64
              pi64Idx:=@TVarData(pidx^).VInt64;i64Dest:=e2;
              while pi64idx^<=i64Dest do begin
                Iterate;
                Inc(pi64idx^);
              end;
            end else begin//int32 optimization
              piIdx:=@TVarData(pidx^).VInteger;iDest:=e2;
              while piIdx^<=iDest do begin
                Iterate;
                Inc(piIdx^);
              end;
            end
          else begin//other types, variants
            while pidx^<=e2 do begin
              Iterate;
              VarInc(pidx^);
            end;
          end;
        end;
      end;
    end else
      ExecError('Fol-loop: Cannot enumerate type '+topas(VarTypeAsText(VarType(pset^))));

  end else begin //standard for
    pidx:=nIndex.RefPtr(AContext);//ref to index
    SubNode(0).SubNode(1).Eval(AContext,pIdx^);//idx:=source
    SubNode(1).Eval(AContext,Dest);//read dest

    worked:=false;
    if nStep=nil then begin //no step
      if FForType=ftTowards then begin
        if pidx^<=dest then begin ft:=ftTo;end
                       else begin ft:=ftDownTo;end;
      end else
        ft:=FForType;
      case ft of
        ftTo:step:=1;
        ftDownTo:step:=-1;
      end;
    end else begin//step
      nStep.Eval(AContext,step);
      if Step=0 then ExecError('Step cannot be 0 in for-loop');
      if Step>0 then ft:=ftTo
                else ft:=ftDownTo;
    end;

    isInt64:=false;
    if varIsInt(pidx^)and varIsInt(dest)and varIsInt(step)then begin//optimizations
      if isInt64 then begin
        pi64Idx:=@TVarData(pidx^).VInt64;i64Dest:=dest;i64Step:=step;
        case ft of  //int64 optimization
          ftTo:while pi64idx^<=i64dest do begin
            Iterate;
            pi64idx^:=pi64idx^+i64Step;
          end;
          ftDownTo:while pi64idx^>=i64dest do begin
            Iterate;
            pi64idx^:=pi64idx^+i64Step;
          end;
        end;
      end else begin  //int32 optimization
        piIdx:=@TVarData(pidx^).VInteger;iDest:=dest;iStep:=step;
        case ft of  //int32 optimization
          ftTo:while piidx^<=idest do begin
            Iterate;
            piidx^:=piidx^+iStep;
          end;
          ftDownTo:while piidx^>=idest do begin
            Iterate;
            piidx^:=piidx^+iStep;
          end;
        end;
      end;
    end else//other types ->variant
      case ft of
        ftTo:while pidx^<=dest do begin
          Iterate;
          pidx^:=pidx^+step; //C-s stilusuan, dest+step a vége
        end;
        ftDownTo:while pidx^>=dest do begin
          Iterate;
          pidx^:=pidx^+step;
        end;
      end;
  end;

  if(not worked)and(SubNode(5)<>nil)then begin//unless
    SubNode(5).Eval(AContext,AResult);
  end;
end;