unit Myc.Data.Value; interface uses System.SysUtils, System.SyncObjs, System.Generics.Collections, Myc.Utils, Myc.Data.Scalar, Myc.Data.Series, Myc.Data.Stream, Myc.Data.Tuple, Myc.Data.Keyword; type TDataValueKind = ( // base types vkVoid, vkScalar, vkText, vkMethod, // generic structured types vkTuple, vkRecord, // scalar structured types // vkScalarTuple, (later) vkScalarRecord, // Series and streams vkSeries, vkRecordSeries, vkStream, // internal types vkManagedObject, vkInterface, vkPointer, vkGeneric ); TDataValue = record type TFunc = reference to function(const ArgNodes: TArray): TDataValue; private type TVal = class(TInterfacedObject) Value: T; {$ifdef DEBUG} TypeHandle: Pointer; {$endif} constructor Create(const AValue: T); end; TObjVal = class(TVal) destructor Destroy; override; end; var FKind: TDataValueKind; FScalar: TScalar; // Single interface field reused for all interface-based types (incl. Streams) // to keep record size small and cache-friendly. FInterface: IInterface; function GetIsVoid: Boolean; inline; public class operator Initialize(out Dest: TDataValue); class function Void: TDataValue; inline; static; // --- Existing Implicits --- class operator Implicit(const AValue: Int64): TDataValue; overload; inline; class operator Implicit(const AValue: Double): TDataValue; overload; inline; class operator Implicit(const AValue: TScalar): TDataValue; overload; inline; class operator Implicit(const AValue: TDataValue): TScalar; overload; inline; class operator Implicit(const AValue: String): TDataValue; overload; inline; class operator Implicit(const AValue: TDataValue.TFunc): TDataValue; overload; inline; class operator Implicit(const AValue: IKeywordMapping): TDataValue; overload; inline; class operator Implicit(const AValue: IKeywordMapping): TDataValue; overload; inline; class operator Implicit(const AValue: IWriteableScalarRecordSeries): TDataValue; overload; inline; class operator Implicit(const AValue: ISeries): TDataValue; overload; inline; class operator Implicit(const AValue: IStream): TDataValue; overload; inline; // --- Existing Factories --- class function FromIntf(const AValue: T): TDataValue; static; function AsIntf: T; inline; class function FromGeneric(const [ref] AValue: T): TDataValue; static; inline; function AsGeneric: T; inline; class function FromPtr(const AValue: Pointer): TDataValue; static; inline; function AsPtr: Pointer; inline; // This take ownership of the object! procedure FromObj(const AValue: TObject); inline; class function Map(const SourceSeries: ISeries; const MapperFunc: TFunc): ISeries; static; // --- Existing Accessors --- function AsScalar: TScalar; inline; function AsMethod: TFunc; inline; function AsText: String; inline; function AsRecordSeries: IWriteableScalarRecordSeries; inline; function AsScalarRecord: IKeywordMapping; inline; function AsRecord: IKeywordMapping; inline; function AsSeries: ISeries; inline; function AsObject: TObject; overload; inline; // New Accessor for Streams function AsStream: IStream; inline; function ToString: String; property IsVoid: Boolean read GetIsVoid; property Kind: TDataValueKind read FKind; end; TDataValueKindHelper = record helper for TDataValueKind public function ToString: string; end; implementation uses System.TypInfo; type TMapSeries = class(TInterfacedObject, ISeries) private FSourceSeries: ISeries; FMapperFunc: TDataValue.TFunc; // ISeries function GetCount: Int64; function GetTotalCount: Int64; function GetItems(Idx: Integer): TScalar; public constructor Create(const ASourceSeries: ISeries; const AMapperFunc: TDataValue.TFunc); end; { TDataValueKindHelper } function TDataValueKindHelper.ToString: string; begin case Self of vkVoid: Result := 'Void'; vkScalar: Result := 'Scalar'; vkText: Result := 'Text'; vkSeries: Result := 'Series'; vkRecordSeries: Result := 'RecordSeries'; vkScalarRecord: Result := 'ScalarRecord'; vkRecord: Result := 'Record'; vkManagedObject: Result := 'Object'; vkMethod: Result := 'Method'; vkInterface: Result := 'Interface'; vkPointer: Result := 'Pointer'; vkGeneric: Result := 'Generic'; vkStream: Result := 'Stream'; else Result := 'Unknown'; end; end; { TDataValue.TVal } constructor TDataValue.TVal.Create(const AValue: T); begin inherited Create; Value := AValue; {$ifdef DEBUG} TypeHandle := TypeInfo(T); {$endif} end; { TDataValue } class operator TDataValue.Initialize(out Dest: TDataValue); begin Dest.FKind := vkVoid; Dest.FInterface := nil; end; function TDataValue.GetIsVoid: Boolean; begin Result := FKind = vkVoid; end; class function TDataValue.Void: TDataValue; begin Result.FKind := vkVoid; Result.FInterface := nil; end; // --- Implicit Operators (Existing) --- class operator TDataValue.Implicit(const AValue: Int64): TDataValue; begin Result.FKind := vkScalar; Result.FScalar := TScalar.FromInt64(AValue); Result.FInterface := nil; end; class operator TDataValue.Implicit(const AValue: Double): TDataValue; begin Result.FKind := vkScalar; Result.FScalar := TScalar.FromDouble(AValue); Result.FInterface := nil; end; class operator TDataValue.Implicit(const AValue: TScalar): TDataValue; begin Result.FKind := vkScalar; Result.FScalar := AValue; Result.FInterface := nil; end; class operator TDataValue.Implicit(const AValue: String): TDataValue; begin Result.FKind := vkText; Result.FInterface := TVal.Create(AValue); end; class operator TDataValue.Implicit(const AValue: TDataValue.TFunc): TDataValue; begin Result.FKind := vkMethod; TFunc(Result.FInterface) := AValue; end; class operator TDataValue.Implicit(const AValue: TDataValue): TScalar; begin if AValue.FKind = vkScalar then Result := AValue.FScalar else raise EInvalidCast.Create('Value is not a scalar'); end; // --- Existing Factories & Accessors --- class function TDataValue.FromIntf(const AValue: T): TDataValue; begin Result.FKind := vkInterface; Result.FInterface := IInterface(AValue); end; class function TDataValue.FromGeneric(const [ref] AValue: T): TDataValue; begin Result.FKind := vkGeneric; if PTypeInfo(TypeInfo(T)).Kind = tkInterface then Result.FInterface := IInterface(Pointer(@AValue)^) else Result.FInterface := TVal.Create(AValue); end; class function TDataValue.FromPtr(const AValue: Pointer): TDataValue; begin Assert(sizeof(Pointer) <= sizeof(Int64)); Result.FKind := vkPointer; Result.FScalar.FromInt64(Int64(AValue)); end; procedure TDataValue.FromObj(const AValue: TObject); begin FKind := vkManagedObject; FInterface := TObjVal.Create(AValue); end; class function TDataValue.Map(const SourceSeries: ISeries; const MapperFunc: TFunc): ISeries; begin Result := TMapSeries.Create(SourceSeries, MapperFunc); end; function TDataValue.AsSeries: ISeries; begin if (FKind <> vkSeries) then raise EInvalidCast.Create('Cannot read value as MemberSeries.'); Result := ISeries(FInterface); end; function TDataValue.AsStream: IStream; begin if (FKind <> vkStream) then raise EInvalidCast.Create('Cannot read value as Stream.'); Result := IStream(FInterface); end; function TDataValue.AsMethod: TFunc; begin if (FKind <> vkMethod) then raise EInvalidCast.Create('Cannot read value as a method.'); Result := TFunc(FInterface); end; function TDataValue.AsGeneric: T; begin if FKind <> vkGeneric then raise EInvalidCast.Create('Cannot read value as generic of ' + String(PTypeInfo(TypeInfo(T)).Name) + '.'); if PTypeInfo(TypeInfo(T)).Kind <> tkInterface then begin {$ifdef DEBUG} var val := TVal(FInterface); if val.TypeHandle <> TypeInfo(T) then raise EInvalidCast.Create('Generic type is not a ' + String(PTypeInfo(TypeInfo(T)).Name) + '.'); {$endif} Result := TVal(FInterface).Value; end else IInterface(Pointer(@Result)^) := FInterface end; function TDataValue.AsIntf: T; begin if FKind <> vkInterface then raise EInvalidCast.Create('Cannot read value as interface.'); Result := T(FInterface); end; function TDataValue.AsObject: TObject; begin if (FKind <> vkManagedObject) then raise EInvalidCast.Create('Cannot read value as object.'); Result := (FInterface as TObjVal).Value; end; function TDataValue.AsPtr: Pointer; begin if (FKind <> vkPointer) then raise EInvalidCast.Create('Cannot read value as pointer.'); Result := Pointer(FScalar.Value.AsInt64); end; function TDataValue.AsScalarRecord: IKeywordMapping; begin if (FKind <> vkScalarRecord) then raise EInvalidCast.Create('Cannot read value as Record.'); Result := IKeywordMapping(FInterface); end; function TDataValue.AsRecord: IKeywordMapping; begin if (FKind <> vkRecord) then raise EInvalidCast.Create('Cannot read value as Record.'); Result := IKeywordMapping(FInterface); end; function TDataValue.AsRecordSeries: IWriteableScalarRecordSeries; begin if (FKind <> vkRecordSeries) then raise EInvalidCast.Create('Cannot read value as RecordSeries.'); Result := IWriteableScalarRecordSeries(FInterface); end; function TDataValue.AsScalar: TScalar; begin if (FKind <> vkScalar) then raise EInvalidCast.Create('Cannot read value as a Scalar.'); Result := FScalar; end; function TDataValue.AsText: String; begin if (FKind <> vkText) then raise EInvalidCast.Create('Cannot read value as Text.'); Result := (FInterface as TVal).Value; end; function TDataValue.ToString: String; var sb: TStringBuilder; genField: TPair; first: Boolean; i: Integer; begin case FKind of vkScalar: Result := FScalar.ToString; vkText: Result := '"' + AsText + '"'; vkSeries: begin var series := AsSeries; Result := Format('', [series.Count]); end; vkRecordSeries: begin var series := AsRecordSeries; sb := TStringBuilder.Create; try sb.Append('{'); first := True; for i := 0 to series.Def.Count - 1 do begin if not first then sb.Append(','); sb.Append(series.Def.Keywords[i].Name); first := False; end; sb.Append('}'); Result := Format('', [sb.ToString, series.RecordCount]); finally sb.Free; end; end; vkScalarRecord: begin var rec := AsScalarRecord; sb := TStringBuilder.Create; try sb.Append('{'); first := True; for i := 0 to rec.Count - 1 do begin if not first then sb.Append(','); sb.Append(rec.Keywords[i].Name); first := False; end; sb.Append('}'); Result := Format('', [sb.ToString]); finally sb.Free; end; end; vkRecord: begin var rec := AsRecord; sb := TStringBuilder.Create; try sb.Append('{'); first := True; for i := 0 to rec.Count - 1 do begin if not first then sb.Append(','); sb.Append(rec.Keywords[i].Name); first := False; end; sb.Append('}'); Result := Format('', [sb.ToString]); finally sb.Free; end; end; vkStream: Result := ''; vkVoid: Result := ''; vkMethod: Result := ''; vkGeneric: Result := ''; vkManagedObject: Result := 'Object: ' + AsObject.ClassName; else Result := '[Unknown DataValue]'; end; end; class operator TDataValue.Implicit(const AValue: IKeywordMapping): TDataValue; begin Result.FKind := vkScalarRecord; Result.FInterface := AValue; end; class operator TDataValue.Implicit(const AValue: IKeywordMapping): TDataValue; begin Result.FKind := vkRecord; Result.FInterface := AValue; end; class operator TDataValue.Implicit(const AValue: IWriteableScalarRecordSeries): TDataValue; begin Result.FKind := vkRecordSeries; Result.FInterface := AValue; end; class operator TDataValue.Implicit(const AValue: ISeries): TDataValue; begin Result.FKind := vkSeries; Result.FInterface := AValue; end; class operator TDataValue.Implicit(const AValue: IStream): TDataValue; begin Result.FKind := vkStream; Result.FInterface := AValue; end; { TMapSeries } constructor TMapSeries.Create(const ASourceSeries: ISeries; const AMapperFunc: TDataValue.TFunc); begin inherited Create; FSourceSeries := ASourceSeries; FMapperFunc := AMapperFunc; end; function TMapSeries.GetCount: Int64; begin Result := FSourceSeries.Count; end; function TMapSeries.GetTotalCount: Int64; begin Result := FSourceSeries.TotalCount; end; function TMapSeries.GetItems(Idx: Integer): TScalar; var sourceValue: TScalar; argArray: TArray; mappedValue: TDataValue; begin sourceValue := FSourceSeries.Items[Idx]; argArray := [TDataValue(sourceValue)]; mappedValue := FMapperFunc(argArray); if mappedValue.Kind <> vkScalar then raise EInvalidCast.Create('Map function did not return a scalar value.'); Result := mappedValue.AsScalar; end; destructor TDataValue.TObjVal.Destroy; begin Value.Free; inherited; end; end.