dws2compiler.pas.bak

script language

      else if sym is TFuncSymbol then
        Result := ReadSymbol(ReadFunc(TFuncSymbol(sym), IsWrite), IsWrite)
      // Cast Float(...)
      else if baseType = FProg.TypFloat then
      begin
        if FTok.TestDelete(ttBLEFT) then
        begin
          Result := TConvFloatExpr.Create(FProg, FTok.HotPos, ReadExpr);
          Result.Typ := sym;
          if not FTok.TestDelete(ttBRIGHT) then
            FMsgs.AddCompilerStop(FTok.HotPos, CPE_BrackRightExpected);
        end
        else
          FMsgs.AddCompilerStop(FTok.HotPos, CPE_BrackLeftExpected)
      end
      // Cast DateTime(...)
      else if baseType = FProg.TypDateTime then
      begin
        if FTok.TestDelete(ttBLEFT) then
        begin
          Result := TConvDateTimeExpr.Create(FProg, FTok.HotPos, ReadExpr);
          Result.Typ := sym;
          if not FTok.TestDelete(ttBRIGHT) then
            FMsgs.AddCompilerStop(FTok.HotPos, CPE_BrackRightExpected);
        end
        else
          FMsgs.AddCompilerStop(FTok.HotPos, CPE_BrackLeftExpected)
      end
      // Cast Integer(...)
      else if baseType = FProg.TypInteger then
      begin
        if FTok.TestDelete(ttBLEFT) then
        begin
          Result := TConvIntegerExpr.Create(FProg, FTok.HotPos, ReadExpr);
          Result.Typ := sym;
          if not FTok.TestDelete(ttBRIGHT) then
            FMsgs.AddCompilerStop(FTok.HotPos, CPE_BrackRightExpected);
        end
        else
          FMsgs.AddCompilerStop(FTok.HotPos, CPE_BrackLeftExpected)
      end
      else
        FMsgs.AddCompilerStop(FTok.HotPos, Format(CPE_UnknownType, [sym.Caption]));

    except
      Result.Free;
      raise;
    end;
  end;
end;

function Tdws2Compiler.ReadField(var Expr: TDataExpr; Sym: TFieldSymbol): TExpr;
begin
  Result := TFieldExpr.Create(FProg, FTok.HotPos, Sym.Typ, Sym, Expr);
end;

// Parses statements like "property[i, j, k] := expr" and "expr := property[i, j, k]"
function Tdws2Compiler.ReadPropertyExpr(var Expr: TDataExpr; PropertySym: TPropertySymbol; IsWrite: Boolean): TExpr;
var
  sym: TSymbol;
  arrayArgs: TExprList;
begin
  Result := nil;
  arrayArgs := TExprList.Create;
  try
    if PropertySym.ArrayIndices.Count > 0 then
      ReadFuncArgs(arrayArgs.AddExpr, ttALEFT, ttARIGHT);

    if IsWrite and FTok.TestDelete(ttASSIGN) then
    begin
      sym := PropertySym.WriteSym;

      // No WriteSym
      if sym = nil then
        FMsgs.AddCompilerStop(FTok.HotPos, CPE_ReadOnlyProperty)
      // WriteSym is a Field
      else if sym is TFieldSymbol then
      begin
        if Expr.Typ is TClassOfSymbol then
          FMsgs.AddCompilerStop(FTok.HotPos, CPE_ObjectReferenceExpected);
        Result := TFieldExpr.Create(FProg, FTok.HotPos, sym.Typ, TFieldSymbol(sym),
          TDataExpr(Expr));
        Result := ReadAssign(Result);
      end
      // WriteSym is a Method
      else if sym is TMethodSymbol then
      begin
        // Convert an assignment to a function call f := x  -->  f(x)
        if Expr.Typ is TClassOfSymbol then
        begin
          // Class properties
          if not TMethodSymbol(sym).IsClassMethod then
            FMsgs.AddCompilerStop(FTok.HotPos, CPE_StaticPropertyWriteExpected);

          Result := GetMethodExpr(TMethodSymbol(sym), TDataExpr(Expr), rkClassOfRef,
            Expr.Pos, True);
        end
        else
          Result := GetMethodExpr(TMethodSymbol(sym), TDataExpr(Expr), rkObjRef,
            Expr.Pos, True);

        try
          Expr := nil; // is part of Result

          // Add array indizes (if any)
          while arrayArgs.Count > 0 do
          begin
            TFuncExpr(Result).AddArg(arrayArgs[0]);
            arrayArgs.Delete(0);
          end;

          if Assigned(PropertySym.IndexSym) then
            TFuncExpr(Result).AddArg(TConstExpr.Create(FProg,FTok.HotPos,
              PropertySym.IndexSym,PropertySym.IndexValue));

          // Add right side of assignment
          TFuncExpr(Result).AddArg(ReadExpr);
        except
          Result.Free;
          raise;
        end;
      end;
    end
    else
    begin
      sym := PropertySym.ReadSym;

      // No ReadSym
      if sym = nil then
        FMsgs.AddCompilerStop(FTok.HotPos, CPE_WriteOnlyProperty)
      // ReadSym is a field
      else if sym is TFieldSymbol then
      begin
        if Expr.Typ is TClassSymbol then
          Result := TFieldExpr.Create(FProg, FTok.HotPos, sym.Typ, TFieldSymbol(sym),
            TDataExpr(Expr))
        else
          FMsgs.AddCompilerStop(FTok.HotPos, CPE_ObjectReferenceExpected);
      end
      // ReadSym is a method
      else if sym is TMethodSymbol then
      begin
        if Expr.Typ is TClassOfSymbol then
          Result := GetMethodExpr(TMethodSymbol(sym), TDataExpr(Expr), rkClassOfRef,
            Expr.Pos, False)
        else
          Result := GetMethodExpr(TMethodSymbol(sym), TDataExpr(Expr), rkObjRef,
            Expr.Pos, False);

        try
          // Add array indizes if any
          while ArrayArgs.Count > 0 do
          begin
            TFuncExpr(Result).AddArg(ArrayArgs[0]);
            ArrayArgs.Delete(0);
          end;

          if Assigned(PropertySym.IndexSym) then
            TFuncExpr(Result).AddArg(TConstExpr.Create(FProg,FTok.HotPos,PropertySym.IndexSym,PropertySym.IndexValue));
        except
          Result.Free;
          raise;
        end;

      end;
    end;

  finally
    arrayArgs.Free;
  end;
end;

function Tdws2Compiler.ReadSymbol(Expr: TExpr; IsWrite: Boolean): TExpr;

  function GetDefaultProperty(cls: TClassSymbol): TPropertySymbol;
  begin
    while Assigned(cls) and not Assigned(cls.DefaultProperty) do
      cls := cls.Parent;
    if Assigned(cls) then
      Result := cls.DefaultProperty
    else
      Result := nil;
  end;

var
  Name: string;
  member: TSymbol;
  DefaultProperty: TPropertySymbol;
  ArraySym: TArraySymbol;
  Typ: TSymbol;
  symPos: TScriptPos;
  BaseType: TTypeSymbol;
begin
  Result := Expr;
  try
    repeat
      Expr := Result;
      Typ := Result.Typ;
      BaseType := GetBaseType(Typ);

      // Member
      if FTok.TestDelete(ttDOT) then
      begin
        if FTok.TestName then
        begin
          Name := FTok.GetToken.FString;
          symPos := FTok.HotPos;
          FTok.KillToken;

            // Record
          if BaseType is TRecordSymbol then
          begin
            member := TRecordSymbol(BaseType).Members.FindLocal(Name);
            if coSymbolDictionary in FCompilerOptions then
              FProg.SymbolDictionary.Add(member, symPos);

            if Assigned(member) then
            begin
              TDataExpr(Result).AddOffset(TMemberSymbol(member).Offset);
              Result.Typ := member.Typ;
            end
            else
              FMsgs.AddCompilerStop(FTok.HotPos, Format(CPE_UnknownMember, [Name]));
            Expr := nil;
          end
            // Class
          else if BaseType is TClassSymbol then
          begin
            member := TClassSymbol(BaseType).Members.FindSymbol(Name);
            if coSymbolDictionary in FCompilerOptions then
              FProg.SymbolDictionary.Add(member, symPos);

            if member is TMethodSymbol then
            begin
              // Member is a method
              if Assigned(TMethodSymbol(member).SelfSym) then
                Result := GetMethodExpr(TMethodSymbol(member), TDataExpr(Result),
                  rkObjRef, Result.Pos, IsWrite)
              else
                Result := GetMethodExpr(TMethodSymbol(member), TDataExpr(Result),
                  rkClassOfRef, Result.Pos, IsWrite);
              ReadFuncArgs(TFuncExpr(Result).AddArg);
            end
            else if member is TFieldSymbol then
              // Member is a field
              Result := TFieldExpr.Create(FProg, FTok.HotPos, member.Typ,
                TFieldSymbol(member), TDataExpr(Result))
            else if member is TPropertySymbol then
              // Member is a property
              Result := ReadPropertyExpr(TDataExpr(Result), TPropertySymbol(member), IsWrite)
            else
              FMsgs.AddCompilerStop(FTok.HotPos, Format(CPE_UnknownMember, [Name]));
          end
            // Class Of
          else if BaseType is TClassOfSymbol then
          begin
            member := TClassSymbol(BaseType.Typ).Members.FindSymbol(Name);
            if coSymbolDictionary in FCompilerOptions then
              FProg.SymbolDictionary.Add(member, FTok.HotPos);

            // Class method
            if member is TMethodSymbol then
            begin
              case TMethodSymbol(member).Kind of
                fkFunction, fkProcedure:
                  if not TMethodSymbol(member).IsClassMethod then
                    FMsgs.AddCompilerStop(FTok.HotPos, CPE_StaticMethodExpected);
                fkDestructor:
                  FMsgs.AddCompilerStop(FTok.HotPos, CPE_StaticMethodExpected);
              end;
              Result := GetMethodExpr(TMethodSymbol(member), TDataExpr(Result),
                rkClassOfRef, Result.Pos, IsWrite);
              ReadFuncArgs(TFuncExpr(Result).AddArg);
            end
              // Static property
            else if member is TPropertySymbol then
              Result := ReadPropertyExpr(TDataExpr(Result), TPropertySymbol(member), IsWrite)
            else
              FMsgs.AddCompilerStop(FTok.HotPos, CPE_StaticMethodExpected);
          end
          else if BaseType is TConnectorSymbol then
          begin
            Result := ReadConnectorSym(Name, Result,
              TConnectorSymbol(BaseType).ConnectorType, IsWrite)
          end
            // Array
          else if BaseType is TArraySymbol then
          begin
            // array.low/high/length
            ArraySym := TArraySymbol(BaseType);
            FreeAndNil(Result);
            if SameText(Name, 'low') then
              Result := TConstExpr.Create(FProg, FTok.HotPos, FProg.TypInteger, ArraySym.LowBound)
            else if SameText(Name, 'high') then
              Result := TConstExpr.Create(FProg, FTok.HotPos, FProg.TypInteger, ArraySym.HighBound)
            else if SameText(Name, 'length') then
              Result := TConstExpr.Create(FProg, FTok.HotPos, FProg.TypInteger, ArraySym.Elements)
            else
              FMsgs.AddCompilerStop(FTok.HotPos, CPE_FieldMethodUnknown);
          end
            // Dynamic Array
          else if BaseType is TDynamicArraySymbol then
          begin
            if SameText(Name, 'low') then
            begin
              FreeAndNil(Result);
              Result := TConstExpr.Create(FProg, FTok.HotPos, FProg.TypInteger, 0)
            end
            else if SameText(Name, 'high') then
            begin
              Result := TSubExpr.Create(FProg, FTok.HotPos,
                TArrayLengthExpr.Create(FProg, FTok.HotPos, TDataExpr(Result)),
                TConstExpr.Create(FProg, FTok.HotPos, FProg.TypInteger, 1));
              Result.TypeCheck; // updates typ
            end
            else if SameText(Name, 'length') then
              Result := TArrayLengthExpr.Create(FProg, FTok.HotPos, TDataExpr(Result))
            else
              FMsgs.AddCompilerStop(FTok.HotPos, CPE_FieldMethodUnknown);
          end
          else
            FMsgs.AddCompilerStop(FTok.HotPos, CPE_NoMemberExpected);
        end
        else
          FMsgs.AddCompilerStop(FTok.HotPos, CPE_NameExpected);
      end
        // Arrays
      else if FTok.Test(ttALEFT) then
      begin
        if Assigned(Result) then
        begin
          if BaseType is TClassSymbol then
          begin
            // array property
            DefaultProperty := GetDefaultProperty(TClassSymbol(BaseType));
            if Assigned(DefaultProperty) then
              Result := ReadPropertyExpr(TDataExpr(Result), DefaultProperty, IsWrite)
            else
              FMsgs.AddCompilerStop(FTok.HotPos, Format(CPE_NoDefaultProperty, [Result.Typ.Name]));
          end
          else
          begin
            // Type "array"
            if BaseType is TStaticArraySymbol then
            begin
              Result := TStaticArrayExpr.Create(FProg, FTok.HotPos, TDataExpr(Result));
              ReadFuncArgs(TStaticArrayExpr(Result).AddIndex, ttALEFT, ttARIGHT);
            end
            else if (BaseType is TDynamicArraySymbol) or (BaseType is TArraySymbol) then
            begin
              Result := TArrayExpr.Create(FProg, FTok.HotPos, TDataExpr(Result));
              ReadFuncArgs(TArrayExpr(Result).AddIndex, ttALEFT, ttARIGHT);
            end
            else if BaseType is TConnectorSymbol then
              Result := ReadConnectorArray('',Result,TConnectorSymbol(BaseType).ConnectorType,IsWrite)
            else
            begin
              FTok.KillToken;
              Result := ReadStringArray(Result, IsWrite)
            end;
          end;
        end;
      end
      else if FTok.Test(ttBLEFT) then
      begin
        if Result.Typ is TFuncSymbol then
          Result := ReadFunc(TFuncSymbol(Result.Typ),IsWrite,Result as TDataExpr)
        else
          FMsgs.AddCompilerStop(FTok.HotPos, CPE_NoMethodExpected);
      end;

    until (Expr = Result) and (Typ = Result.Typ);
  except
    Result.Free;
    raise;
  end;
end;

function Tdws2Compiler.ReadExternalVar;
begin
  Result := nil;
  try
    if IsWrite then
    begin
      if FTok.Tes