diff --git a/Src/AST/Myc.Ast.Binding.pas b/Src/AST/Myc.Ast.Binding.pas index 1c10f51..57d6ba5 100644 --- a/Src/AST/Myc.Ast.Binding.pas +++ b/Src/AST/Myc.Ast.Binding.pas @@ -259,14 +259,10 @@ begin // externally evaluate the expression using the injected evaluator value := FEvaluate(expr); - // Allow unquoting keywords - if value.Kind in [vkScalar, vkText, vkVoid, vkKeyword] then + // Allow unquoting scalars (which now include keywords) + if value.Kind in [vkScalar, vkText, vkVoid] then begin - // vkKeyword needs to be handled differently than other constants - if value.Kind = vkKeyword then - Result := TDataValue.FromIntf(TAst.Keyword(value.AsKeyword.Name)) - else - Result := TDataValue.FromIntf(TAst.Constant(value)); + Result := TDataValue.FromIntf(TAst.Constant(value)); end else raise Exception.CreateFmt('Cannot unquote complex value of type %s at compile time.', [value.Kind.ToString]); @@ -795,7 +791,6 @@ begin Result := SetType(TDataValue.FromIntf(Node), TTypes.FromScalarKind(Node.Value.AsScalar.Kind)); TDataValueKind.vkText: Result := SetType(TDataValue.FromIntf(Node), TTypes.Text); TDataValueKind.vkVoid: Result := SetType(TDataValue.FromIntf(Node), TTypes.Void); - TDataValueKind.vkKeyword: Result := SetType(TDataValue.FromIntf(Node), TTypes.Keyword); else // Handle other constant types if they become supported Result := SetType(TDataValue.FromIntf(Node), TTypes.Unknown); @@ -805,7 +800,8 @@ end; function TAstBinder.VisitKeyword(const Node: IKeywordNode): TDataValue; begin // Keywords are literals. Their type is set in TKeywordNode.Create. - Result := TDataValue.FromIntf(Node); + // We also set the static type on the node itself during binding. + Result := SetType(TDataValue.FromIntf(Node), TTypes.Keyword); end; function TAstBinder.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; @@ -966,34 +962,32 @@ var boundNode: IRecordLiteralNode; valNode: IAstNode; valType: IStaticType; + scalarKind: TScalar.TKind; begin FNextIsTail := False; SetLength(boundFields, Length(Node.Fields)); SetLength(defFields, Length(Node.Fields)); - // We assume this is a TScalarRecord (Path A) until proven otherwise. - // The "dual path" logic for stDictionary is not yet implemented. - for i := 0 to High(Node.Fields) do begin valNode := Accept(Node.Fields[i].Value).AsIntf; valType := (valNode as TAstNode).StaticType; - // Path A: Records can only store scalar values - if not (valType.Kind in [stOrdinal, stFloat]) then + // Path A: Records can now store Ordinal, Float, or Keyword + if (valType.Kind = stOrdinal) then + scalarKind := TScalar.TKind.Ordinal + else if (valType.Kind = stFloat) then + scalarKind := TScalar.TKind.Float + else if (valType.Kind = stKeyword) then + scalarKind := TScalar.TKind.Keyword + else raise ETypeException.CreateFmt( - 'Record fields must be scalar (Ordinal or Float), but field ":%s" is %s', + 'Record fields must be scalar (Ordinal, Float, or Keyword), but field ":%s" is %s', [Node.Fields[i].Key.Value.Name, valType.ToString]); boundFields[i] := TRecordFieldLiteral.Create(Node.Fields[i].Key, valNode); - var scalarKind: TScalar.TKind; - if valType.Kind = stOrdinal then - scalarKind := TScalar.TKind.Ordinal - else - scalarKind := TScalar.TKind.Float; - - // Create the definition field using the Keyword's name + // Create the definition field using the Keyword and its TScalar.TKind defFields[i] := TScalarRecordField.Create(Node.Fields[i].Key.Value, scalarKind); end; diff --git a/Src/AST/Myc.Ast.Evaluator.pas b/Src/AST/Myc.Ast.Evaluator.pas index 37a223c..283f2fc 100644 --- a/Src/AST/Myc.Ast.Evaluator.pas +++ b/Src/AST/Myc.Ast.Evaluator.pas @@ -152,17 +152,16 @@ end; function TEvaluatorVisitor.IsTruthy(const AValue: TDataValue): Boolean; begin + // Other types (Text, Series, etc.) are considered "false" in a boolean context if (AValue.Kind <> vkScalar) then - begin - Result := False; - exit; - end; + exit(false); case AValue.AsScalar.Kind of - TScalar.TKind.Ordinal: Result := (AValue.AsScalar.Value.AsInt64 <> 0); - TScalar.TKind.Float: Result := (AValue.AsScalar.Value.AsDouble <> 0.0); + TScalar.TKind.Ordinal: Result := AValue.AsScalar.Value.AsInt64 <> 0; + TScalar.TKind.Float: Result := AValue.AsScalar.Value.AsDouble <> 0.0; + TScalar.TKind.Keyword: Result := AValue.AsScalar.Value.AsInt64 <> 0; else - Result := False; + Result := false; end; end; @@ -368,8 +367,8 @@ end; function TEvaluatorVisitor.VisitKeyword(const Node: IKeywordNode): TDataValue; begin - // Return the shared, interned IKeyword interface as a TDataValue - Result := TDataValue.FromKeyword(Node.Value); + // Return the keyword as a TScalar value + Result := TDataValue(TScalar.FromKeyword(Node.Value)); end; function TEvaluatorVisitor.VisitCreateSeries(const Node: ICreateSeriesNode): TDataValue; @@ -402,6 +401,8 @@ function TEvaluatorVisitor.VisitIndexer(const Node: IIndexerNode): TDataValue; var baseValue, indexValue: TDataValue; index: Int64; + series: ISeries; + recSeries: IRecordSeries; begin baseValue := Node.Base.Accept(Self); indexValue := Node.Index.Accept(Self); @@ -414,12 +415,23 @@ begin case baseValue.Kind of vkSeries: begin - with baseValue.AsSeries do - begin - if (index < 0) or (index >= TotalCount) then - raise EArgumentException.CreateFmt('Index %d is out of bounds for series with %d elements.', [index, TotalCount]); - Result := Items[Integer(index)]; - end; + series := baseValue.AsSeries; + if (index < 0) or (index >= series.TotalCount) then + raise EArgumentException.CreateFmt('Index %d is out of bounds for series with %d elements.', [index, series.TotalCount]); + Result := series.Items[Integer(index)]; + end; + vkRecordSeries: + begin + recSeries := baseValue.AsRecordSeries; + if (index < 0) or (index >= recSeries.TotalCount) then + raise EArgumentException.CreateFmt('Index %d is out of bounds for series with %d elements.', [index, recSeries.TotalCount]); + // Accessing a record series by index materializes the TScalarRecord + var rec := TScalarRecord.Create(recSeries.Def, nil); // Nil fields, needs implementation + // TODO: This path (materializing a record from TScalarRecordSeries) is not fully implemented. + // We need to fetch the underlying TScalar.TValue array slice. + // For now, returning an empty record shell. + raise ENotSupportedException.Create('Indexing a RecordSeries to materialize a Record is not yet implemented.'); + Result := TDataValue.FromRecord(rec); end; else raise EArgumentException.Create('Indexer `[]` is not supported for this value type.'); @@ -455,8 +467,17 @@ begin begin // Evaluate the value expression for this field valData := boundNode.Fields[i].Value.Accept(Self); - // The binder already validated this is a scalar - values[i] := valData.AsScalar.Value; + + if valData.Kind = vkScalar then + begin + // Binder ensures it's a valid scalar kind (Ordinal, Float, Keyword) + values[i] := valData.AsScalar.Value; + end + else + begin + // This should be unreachable if binder worked correctly + raise EInvalidOpException.Create('Invalid type found in record literal during evaluation.'); + end; end; // Create the TScalarRecord using the definition from the binder @@ -501,32 +522,9 @@ begin leftValue := Node.Left.Accept(Self); rightValue := Node.Right.Accept(Self); - // Handle Keyword equality - if (leftValue.Kind = vkKeyword) or (rightValue.Kind = vkKeyword) then - begin - if not (leftValue.Kind = rightValue.Kind) then - begin - // Comparing keyword to non-keyword - if Node.Operator = TScalar.TBinaryOp.NotEqual then - Result := TScalar.FromInt64(1) - else - Result := TScalar.FromInt64(0); - exit; - end; - - // Both are keywords, compare interfaces - case Node.Operator of - TScalar.TBinaryOp.Equal: Result := TScalar.FromInt64(Ord(leftValue.AsKeyword = rightValue.AsKeyword)); - TScalar.TBinaryOp.NotEqual: Result := TScalar.FromInt64(Ord(leftValue.AsKeyword <> rightValue.AsKeyword)); - else - raise ENotSupportedException.Create('Only = and <> operations are supported for Keywords.'); - end; - exit; - end; - // Standard scalar operations if (leftValue.Kind <> vkScalar) or (rightValue.Kind <> vkScalar) then - raise ENotSupportedException.Create('Binary operations are only supported for scalar or keyword types.'); + raise ENotSupportedException.Create('Binary operations are only supported for scalar types.'); if not TScalar.TryBinaryOperation(Node.Operator, leftValue.AsScalar, rightValue.AsScalar, resScalar) then raise ENotSupportedException.Create( diff --git a/Src/AST/Myc.Ast.JSON.pas b/Src/AST/Myc.Ast.JSON.pas index e5ec185..e978ca0 100644 --- a/Src/AST/Myc.Ast.JSON.pas +++ b/Src/AST/Myc.Ast.JSON.pas @@ -114,6 +114,7 @@ end; procedure TJsonAstConverter.DataValueToJson(const AValue: TDataValue; const AParent: TJSONObject; const AName: string); var valObj, scalarObj: TJSONObject; + kwName: string; begin valObj := TJSONObject.Create; valObj.AddPair('Kind', TJSONString.Create(AValue.Kind.ToString)); @@ -126,11 +127,16 @@ begin case AValue.AsScalar.Kind of TScalar.TKind.Ordinal: scalarObj.AddPair('Value', TJSONNumber.Create(AValue.AsScalar.Value.AsInt64)); TScalar.TKind.Float: scalarObj.AddPair('Value', TJSONNumber.Create(AValue.AsScalar.Value.AsDouble)); + TScalar.TKind.Keyword: + begin + // Use reverse map to get name from index (AsInt64) + kwName := TKeywordRegistry.GetName(AValue.AsScalar.Value.AsInt64); + scalarObj.AddPair('Value', TJSONString.Create(kwName)); + end; end; valObj.AddPair('Value', scalarObj); end; vkText: valObj.AddPair('Value', TJSONString.Create(AValue.AsText)); - vkKeyword: valObj.AddPair('Value', TJSONString.Create(AValue.AsKeyword.Name)); vkVoid:; // No value to add else raise ENotSupportedException.Create('Unsupported TDataValue kind for constant serialization.'); @@ -660,16 +666,15 @@ begin case scalarKind of TScalar.TKind.Ordinal: Result := TScalar.FromInt64(scalarObj.GetValue('Value').AsInt64); TScalar.TKind.Float: Result := TScalar.FromDouble(scalarObj.GetValue('Value').AsDouble); + TScalar.TKind.Keyword: + // Keywords are serialized by name, intern them back + Result := TScalar.FromKeyword(TKeywordRegistry.Intern(scalarObj.GetValue('Value'))); end; end else if SameText(kindStr, 'Text') then begin Result := valObj.GetValue('Value'); end - else if SameText(kindStr, 'Keyword') then - begin - Result := TDataValue.FromKeyword(TKeywordRegistry.Intern(valObj.GetValue('Value'))); - end else if SameText(kindStr, 'Void') then begin Result := TDataValue.Void; diff --git a/Src/AST/Myc.Ast.Types.pas b/Src/AST/Myc.Ast.Types.pas index 3286156..bf170da 100644 --- a/Src/AST/Myc.Ast.Types.pas +++ b/Src/AST/Myc.Ast.Types.pas @@ -381,6 +381,9 @@ begin exit(False); var otherDef := Other.Definition; + if (not Assigned(Self.FDefinition)) or (not Assigned(otherDef)) then + exit(False); // Should not happen if Kind is equal, but defensive check + if Length(Self.FDefinition.Fields) <> Length(otherDef.Fields) then exit(False); @@ -399,11 +402,14 @@ var i: Integer; begin Result := GetKind.ToString + '{'; - for i := 0 to High(FDefinition.Fields) do + if Assigned(FDefinition) then begin - Result := Result + FDefinition.Fields[i].Key.Name + ': ' + FDefinition.Fields[i].Value.ToString; - if i < High(FDefinition.Fields) then - Result := Result + ', '; + for i := 0 to High(FDefinition.Fields) do + begin + Result := Result + FDefinition.Fields[i].Key.Name + ': ' + FDefinition.Fields[i].Value.ToString; + if i < High(FDefinition.Fields) then + Result := Result + ', '; + end; end; Result := Result + '}'; end; @@ -446,6 +452,7 @@ begin case AKind of TScalar.TKind.Ordinal: Result := FOrdinal; TScalar.TKind.Float: Result := FFloat; + TScalar.TKind.Keyword: Result := FKeyword; else raise ETypeException.Create('Cannot convert invalid TScalar.TKind to TStaticType.'); end; @@ -472,6 +479,9 @@ begin if (Target.Kind = stVoid) and (Source.Kind = stMethod) then exit(True); + if (Target.Kind = stOrdinal) and (Source.Kind = stKeyword) then + exit(True); + // TODO: Implement full assignment compatibility rules (e.g., for records/series) Result := False; @@ -499,11 +509,11 @@ begin if (A.Kind = stOrdinal) and (B.Kind = stOrdinal) then exit(TTypes.Ordinal); - // If types are identical and not numeric, return that type (e.g. Text + Text might be valid later) + // If types are identical (incl. Keyword, Text, etc.), return that type. if A.IsEqual(B) then exit(A); - // Cannot promote other combinations during basic inference + // Cannot promote other combinations (e.g., Ordinal and Keyword) raise ETypeException.CreateFmt('Cannot promote types %s and %s', [A.ToString, B.ToString]); end; @@ -551,24 +561,18 @@ begin TScalar.TBinaryOp.Equal, TScalar.TBinaryOp.NotEqual: begin - // Allow equality checks for Keywords - if (promotedKind = stKeyword) then - begin - Result := TTypes.Ordinal; - exit; - end; - - // Comparison requires Ordinal or Float, but *always* results in Ordinal (boolean) - if not (promotedKind in [stOrdinal, stFloat]) then + // Allow equality checks for Ordinal, Float, or Keyword + if not (promotedKind in [stOrdinal, stFloat, stKeyword]) then raise ETypeException.CreateFmt( 'Comparison operator %s requires Ordinal, Float, or Keyword, but got %s after promotion', [Op.ToString, promotedType.ToString]); + // Result is always Ordinal (boolean) Result := TTypes.Ordinal; end; TScalar.TBinaryOp.Less, TScalar.TBinaryOp.Greater, TScalar.TBinaryOp.LessOrEqual, TScalar.TBinaryOp.GreaterOrEqual: begin - // Comparison requires Ordinal or Float, but *always* results in Ordinal (boolean) + // Comparison requires Ordinal or Float (Keywords are not ordered) if not (promotedKind in [stOrdinal, stFloat]) then raise ETypeException.CreateFmt( 'Comparison operator %s requires Ordinal or Float, but got %s after promotion', @@ -593,6 +597,7 @@ begin case Op of TScalar.TUnaryOp.Negate: begin + // Negation requires Ordinal or Float if not (rightKind in [stOrdinal, stFloat]) then raise ETypeException.CreateFmt('Unary negation cannot be applied to %s', [Right.ToString]); Result := Right; // Negation preserves type @@ -600,6 +605,7 @@ begin TScalar.TUnaryOp.Not: begin + // Logical not only applies to Ordinal (booleans) if not (rightKind = stOrdinal) then raise ETypeException.CreateFmt('Logical not cannot be applied to %s', [Right.ToString]); Result := TTypes.Ordinal; diff --git a/Src/AST/Myc.Ast.pas b/Src/AST/Myc.Ast.pas index 91f41aa..8490b1b 100644 --- a/Src/AST/Myc.Ast.pas +++ b/Src/AST/Myc.Ast.pas @@ -349,17 +349,17 @@ constructor TConstantNode.Create(const AValue: TDataValue); begin inherited Create; // Validate that only allowed constant kinds are used. - if not (AValue.Kind in [vkScalar, vkText, vkVoid, vkKeyword]) then - raise EArgumentException.Create('IConstantNode only supports Scalar, Text, Void and Keyword values.'); + // vkKeyword is no longer a valid TDataValue kind. + if not (AValue.Kind in [vkScalar, vkText, vkVoid]) then + raise EArgumentException.Create('IConstantNode only supports Scalar, Text, and Void values.'); FValue := AValue; case AValue.Kind of vkScalar: StaticType := TTypes.FromScalarKind(AValue.AsScalar.Kind); vkText: StaticType := TTypes.Text; vkVoid: StaticType := TTypes.Void; - vkKeyword: StaticType := TTypes.Keyword; else - StaticType := TTypes.Unknown; // Should not happen due to validation above + StaticType := TTypes.Unknown; // Should not happen end; end; diff --git a/Src/Data/Myc.Data.Keyword.pas b/Src/Data/Myc.Data.Keyword.pas index 3e203a1..176c480 100644 --- a/Src/Data/Myc.Data.Keyword.pas +++ b/Src/Data/Myc.Data.Keyword.pas @@ -35,11 +35,15 @@ type FLock: TSpinLock; class var FRegistry: TDictionary; + class var + FReverseMap: TList; // Use TList class constructor Create; class destructor Destroy; public // Gets or creates the interned keyword for the given name. class function Intern(const AName: string): IKeyword; static; + // Gets the name for a given keyword index. + class function GetName(AIdx: Integer): string; static; end; // Defines a mapping from Keywords to a generic value T @@ -113,11 +117,30 @@ class constructor TKeywordRegistry.Create; begin FLock := TSpinLock.Create(false); FRegistry := TDictionary.Create; + FReverseMap := TList.Create; + + Intern('false'); + Intern('true'); end; class destructor TKeywordRegistry.Destroy; begin FRegistry.Free; + FReverseMap.Free; +end; + +class function TKeywordRegistry.GetName(AIdx: Integer): string; +begin + FLock.Enter; + try + // Check bounds + if (AIdx >= 0) and (AIdx < FReverseMap.Count) then + Result := FReverseMap[AIdx].Name + else + Result := ''; // Return empty for safety + finally + FLock.Exit; + end; end; class function TKeywordRegistry.Intern(const AName: string): IKeyword; @@ -127,7 +150,8 @@ begin if not FRegistry.TryGetValue(AName, Result) then begin Result := TKeyword.Create(AName, FRegistry.Count); - FRegistry.Add(AName, Result); + FReverseMap.Add(Result); // Add to reverse map (Idx -> Interface) + FRegistry.Add(AName, Result); // Add to forward map (Name -> Interface) end; finally FLock.Exit; @@ -200,6 +224,7 @@ end; class function TKeywordMappingRegistry.Intern(const AFields: TArray>): IKeywordMapping; var key: TArray; + newMapping: IKeywordMapping; begin SetLength(key, Length(AFields)); for var i := 0 to High(key) do @@ -216,7 +241,7 @@ begin end; // 4. Not in cache. Create (O(N+M)) - OUTSIDE lock - var newMapping := TKeywordMapping.Create(AFields) as IKeywordMapping; + newMapping := TKeywordMapping.Create(AFields) as IKeywordMapping; // 5. Lock again to add FLock.Enter; diff --git a/Src/Data/Myc.Data.Scalar.pas b/Src/Data/Myc.Data.Scalar.pas index 559344e..13fe710 100644 --- a/Src/Data/Myc.Data.Scalar.pas +++ b/Src/Data/Myc.Data.Scalar.pas @@ -6,6 +6,7 @@ uses System.SysUtils, System.Generics.Collections, System.Generics.Defaults, + Myc.Utils, Myc.Data.Decimal, Myc.Data.Series, Myc.Data.Keyword; @@ -17,11 +18,13 @@ type TScalar = record public type - TKind = (Ordinal, Float); + // Defines the underlying storage kinds for scalar values + TKind = (Ordinal, Float, Keyword); + // The 8-byte storage for the scalar value TValue = record case TKind of - TKind.Ordinal: (AsInt64: Int64); + TKind.Ordinal, TKind.Keyword: (AsInt64: Int64); // Ordinal and Keyword index TKind.Float: (AsDouble: Double); end; @@ -51,10 +54,12 @@ type // Factory methods for core types. class function FromInt64(AValue: Int64): TScalar; static; inline; class function FromDouble(AValue: Double): TScalar; static; inline; + class function FromKeyword(const AValue: IKeyword): TScalar; static; inline; // Implicit casts for core types. class operator Implicit(AValue: Int64): TScalar; overload; inline; class operator Implicit(AValue: Double): TScalar; overload; inline; + class operator Implicit(const AValue: IKeyword): TScalar; overload; inline; class operator Implicit(const A: TScalar): Double; overload; class operator Implicit(const A: TScalar): Int64; overload; @@ -159,19 +164,17 @@ type // A time series of scalar records, optimized for memory and access speed. TScalarRecordSeries = class(TInterfacedObject, IRecordSeries) type - TMemberSeries = class(TObject, ISeries) + TMemberSeries = class(TGenericContainedObject, ISeries) private - FRecordSeries: TScalarRecordSeries; FKind: TScalar.TKind; FOffset: Integer; function GetCount: Int64; function GetItems(Idx: Integer): TScalar; + function GetRecordSeries: TScalarRecordSeries; inline; function GetTotalCount: Int64; - function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall; - function _AddRef: Integer; stdcall; - function _Release: Integer; stdcall; public constructor Create(ARecordSeries: TScalarRecordSeries; AElementIdx: Integer); + property RecordSeries: TScalarRecordSeries read GetRecordSeries; end; private FDef: IScalarRecordDefinition; @@ -219,6 +222,20 @@ begin Result.Value.AsDouble := AValue; end; +class function TScalar.FromInt64(AValue: Int64): TScalar; +begin + Result.Kind := TKind.Ordinal; + Result.Value.AsInt64 := AValue; +end; + +class function TScalar.FromKeyword(const AValue: IKeyword): TScalar; +begin + Result.Kind := TKind.Keyword; + if not Assigned(AValue) then + raise EArgumentException.Create('Keyword must not be nil.'); + Result.Value.AsInt64 := AValue.Idx +end; + class operator TScalar.Implicit(AValue: Double): TScalar; begin Result.Kind := TKind.Float; @@ -231,39 +248,58 @@ begin Result.Value.AsInt64 := AValue; end; +class operator TScalar.Implicit(const AValue: IKeyword): TScalar; +begin + Result.Kind := TKind.Keyword; + if not Assigned(AValue) then + raise EArgumentException.Create('Keyword must not be nil.'); + Result.Value.AsInt64 := AValue.Idx +end; + class operator TScalar.Implicit(const A: TScalar): Double; begin - if A.Kind = TKind.Ordinal then - Result := A.Value.AsInt64 + case A.Kind of + TKind.Ordinal: Result := A.Value.AsInt64; + TKind.Float: Result := A.Value.AsDouble; else - Result := A.Value.AsDouble; + raise EInvalidCast.Create('Cannot implicitly convert Keyword to Double'); + end; end; class operator TScalar.Implicit(const A: TScalar): Int64; begin - if A.Kind = TKind.Ordinal then - Result := A.Value.AsInt64 + case A.Kind of + TKind.Ordinal: Result := A.Value.AsInt64; else - raise EInvalidCast.Create('Cannot implicitly convert a Float to an Int64'); -end; - -class function TScalar.FromInt64(AValue: Int64): TScalar; -begin - Result.Kind := TKind.Ordinal; - Result.Value.AsInt64 := AValue; + raise EInvalidCast.CreateFmt('Cannot implicitly convert %s to Int64', [A.Kind.ToString]); + end; end; class function TScalar.IsBinaryOperatorSupported(Op: TBinaryOp; A, B: TKind): Boolean; begin + // Deny all operations if either operand is Keyword... + if (A = TKind.Keyword) or (B = TKind.Keyword) then + begin + // ...except for Equality checks + Result := (Op in [TBinaryOp.Equal, TBinaryOp.NotEqual]); + exit; + end; + + // Default for Ordinal/Float Result := True; end; class function TScalar.IsUnaryOperatorSupported(Op: TUnaryOp; A: TKind): Boolean; begin + // Deny all unary ops for Keywords + if (A = TKind.Keyword) then + exit(False); + + // Deny 'not' for Float if (Op = TUnaryOp.Not) and (A = TKind.Float) then - Result := False - else - Result := True; + exit(False); + + Result := True; end; class function TScalar.StringToKind(const AName: string): TKind; @@ -272,6 +308,8 @@ begin Result := TKind.Ordinal else if SameText(AName, 'Float') then Result := TKind.Float + else if SameText(AName, 'Keyword') then + Result := TKind.Keyword else raise EArgumentException.CreateFmt('Unknown scalar type name: "%s"', [AName]); end; @@ -281,6 +319,7 @@ begin case Kind of TKind.Ordinal: Result := IntToStr(Value.AsInt64); TKind.Float: Result := FloatToStr(Value.AsDouble); + TKind.Keyword: Result := TKeywordRegistry.GetName(Value.AsInt64); else Result := '[Unknown Scalar]'; end; @@ -288,6 +327,9 @@ end; class function TScalar.TryBinaryOperation(Op: TBinaryOp; const A, B: TScalar; out Res: TScalar): Boolean; begin + if not IsBinaryOperatorSupported(Op, A.Kind, B.Kind) then + exit(False); + try case Op of TBinaryOp.Add: Res := A + B; @@ -313,10 +355,7 @@ end; class function TScalar.TryUnaryOperation(Op: TUnaryOp; const A: TScalar; out Res: TScalar): Boolean; begin if not IsUnaryOperatorSupported(Op, A.Kind) then - begin - Result := False; - exit; - end; + exit(False); try case Op of TUnaryOp.Negate: Res := -A; @@ -335,51 +374,40 @@ class operator TScalar.Add(const A, B: TScalar): TScalar; begin if (A.Kind = TKind.Ordinal) and (B.Kind = TKind.Ordinal) then Result := A.Value.AsInt64 + B.Value.AsInt64 - else + else if (A.Kind = TKind.Float) or (B.Kind = TKind.Float) then begin var valA, valB: Double; - if A.Kind = TKind.Ordinal then - valA := A.Value.AsInt64 - else - valA := A.Value.AsDouble; - if B.Kind = TKind.Ordinal then - valB := B.Value.AsInt64 - else - valB := B.Value.AsDouble; + valA := A; // Use implicit cast + valB := B; // Use implicit cast Result := valA + valB; - end; + end + else + raise EArgumentException.CreateFmt('Operator Add not supported for types %s and %s', [A.Kind.ToString, B.Kind.ToString]); end; class operator TScalar.Divide(const A, B: TScalar): TScalar; begin + // Division *always* promotes to Float, unless types are invalid + if (A.Kind = TKind.Keyword) or (B.Kind = TKind.Keyword) then + raise EArgumentException.CreateFmt('Operator Divide not supported for types %s and %s', [A.Kind.ToString, B.Kind.ToString]); + var valA, valB: Double; - if A.Kind = TKind.Ordinal then - valA := A.Value.AsInt64 - else - valA := A.Value.AsDouble; - if B.Kind = TKind.Ordinal then - valB := B.Value.AsInt64 - else - valB := B.Value.AsDouble; + valA := A; // Use implicit cast + valB := B; // Use implicit cast Result := valA / valB; end; class operator TScalar.Equal(const A, B: TScalar): Boolean; begin - if (A.Kind = TKind.Ordinal) and (B.Kind = TKind.Ordinal) then - Result := A.Value.AsInt64 = B.Value.AsInt64 + // Must be same kind to be equal (e.g., Ordinal(5) <> Keyword(5)) + if A.Kind <> B.Kind then + exit(False); + + case A.Kind of + TKind.Ordinal, TKind.Keyword: Result := A.Value.AsInt64 = B.Value.AsInt64; + TKind.Float: Result := A.Value.AsDouble = B.Value.AsDouble; else - begin - var valA, valB: Double; - if A.Kind = TKind.Ordinal then - valA := A.Value.AsInt64 - else - valA := A.Value.AsDouble; - if B.Kind = TKind.Ordinal then - valB := B.Value.AsInt64 - else - valB := B.Value.AsDouble; - Result := valA = valB; + Result := False; end; end; @@ -387,19 +415,15 @@ class operator TScalar.GreaterThan(const A, B: TScalar): Boolean; begin if (A.Kind = TKind.Ordinal) and (B.Kind = TKind.Ordinal) then Result := A.Value.AsInt64 > B.Value.AsInt64 - else + else if (A.Kind = TKind.Float) or (B.Kind = TKind.Float) then begin var valA, valB: Double; - if A.Kind = TKind.Ordinal then - valA := A.Value.AsInt64 - else - valA := A.Value.AsDouble; - if B.Kind = TKind.Ordinal then - valB := B.Value.AsInt64 - else - valB := B.Value.AsDouble; + valA := A; + valB := B; Result := valA > valB; - end; + end + else + raise EArgumentException.CreateFmt('Operator GreaterThan not supported for types %s and %s', [A.Kind.ToString, B.Kind.ToString]); end; class operator TScalar.GreaterThanOrEqual(const A, B: TScalar): Boolean; @@ -411,19 +435,15 @@ class operator TScalar.LessThan(const A, B: TScalar): Boolean; begin if (A.Kind = TKind.Ordinal) and (B.Kind = TKind.Ordinal) then Result := A.Value.AsInt64 < B.Value.AsInt64 - else + else if (A.Kind = TKind.Float) or (B.Kind = TKind.Float) then begin var valA, valB: Double; - if A.Kind = TKind.Ordinal then - valA := A.Value.AsInt64 - else - valA := A.Value.AsDouble; - if B.Kind = TKind.Ordinal then - valB := B.Value.AsInt64 - else - valB := B.Value.AsDouble; + valA := A; + valB := B; Result := valA < valB; - end; + end + else + raise EArgumentException.CreateFmt('Operator LessThan not supported for types %s and %s', [A.Kind.ToString, B.Kind.ToString]); end; class operator TScalar.LessThanOrEqual(const A, B: TScalar): Boolean; @@ -434,7 +454,7 @@ end; class operator TScalar.LogicalNot(const A: TScalar): TScalar; begin if A.Kind <> TKind.Ordinal then - raise EArgumentException.Create('Operator Not not supported for type Float'); + raise EArgumentException.CreateFmt('Operator Not not supported for type %s', [A.Kind.ToString]); if A.Value.AsInt64 = 0 then Result := 1 @@ -446,19 +466,15 @@ class operator TScalar.Multiply(const A, B: TScalar): TScalar; begin if (A.Kind = TKind.Ordinal) and (B.Kind = TKind.Ordinal) then Result := A.Value.AsInt64 * B.Value.AsInt64 - else + else if (A.Kind = TKind.Float) or (B.Kind = TKind.Float) then begin var valA, valB: Double; - if A.Kind = TKind.Ordinal then - valA := A.Value.AsInt64 - else - valA := A.Value.AsDouble; - if B.Kind = TKind.Ordinal then - valB := B.Value.AsInt64 - else - valB := B.Value.AsDouble; + valA := A; + valB := B; Result := valA * valB; - end; + end + else + raise EArgumentException.CreateFmt('Operator Multiply not supported for types %s and %s', [A.Kind.ToString, B.Kind.ToString]); end; class operator TScalar.Negative(const A: TScalar): TScalar; @@ -467,6 +483,8 @@ begin case A.Kind of TKind.Ordinal: Result.Value.AsInt64 := -A.Value.AsInt64; TKind.Float: Result.Value.AsDouble := -A.Value.AsDouble; + else + raise EArgumentException.CreateFmt('Operator Negative not supported for type %s', [A.Kind.ToString]); end; end; @@ -478,10 +496,7 @@ end; class operator TScalar.Round(const A: TScalar): TScalar; begin var val: Double; - if A.Kind = TKind.Ordinal then - val := A.Value.AsInt64 - else - val := A.Value.AsDouble; + val := A; // Implicit cast handles Ordinal or Float Result := System.Round(val); end; @@ -489,28 +504,21 @@ class operator TScalar.Subtract(const A, B: TScalar): TScalar; begin if (A.Kind = TKind.Ordinal) and (B.Kind = TKind.Ordinal) then Result := A.Value.AsInt64 - B.Value.AsInt64 - else + else if (A.Kind = TKind.Float) or (B.Kind = TKind.Float) then begin var valA, valB: Double; - if A.Kind = TKind.Ordinal then - valA := A.Value.AsInt64 - else - valA := A.Value.AsDouble; - if B.Kind = TKind.Ordinal then - valB := B.Value.AsInt64 - else - valB := B.Value.AsDouble; + valA := A; + valB := B; Result := valA - valB; - end; + end + else + raise EArgumentException.CreateFmt('Operator Subtract not supported for types %s and %s', [A.Kind.ToString, B.Kind.ToString]); end; class operator TScalar.Trunc(const A: TScalar): TScalar; begin var val: Double; - if A.Kind = TKind.Ordinal then - val := A.Value.AsInt64 - else - val := A.Value.AsDouble; + val := A; // Implicit cast handles Ordinal or Float Result := System.Trunc(val); end; @@ -607,17 +615,20 @@ begin Result := FTotalCount; end; +{ TScalar.TKindHelper } + function TScalar.TKindHelper.ToString: string; begin case Self of TScalar.TKind.Ordinal: Result := 'Ordinal'; TScalar.TKind.Float: Result := 'Float'; + TScalar.TKind.Keyword: Result := 'Keyword'; else Result := 'unknown'; end; end; -{ TScalar_TBinaryOpHelper } +{ TScalar.TBinaryOpHelper } function TScalar.TBinaryOpHelper.ToString: string; begin @@ -637,7 +648,7 @@ begin end; end; -{ TScalar_TUnaryOpHelper } +{ TScalar.TUnaryOpHelper } function TScalar.TUnaryOpHelper.ToString: string; begin @@ -653,47 +664,33 @@ end; constructor TScalarRecordSeries.TMemberSeries.Create(ARecordSeries: TScalarRecordSeries; AElementIdx: Integer); begin - inherited Create; - FRecordSeries := ARecordSeries; - FKind := FRecordSeries.FDef.Fields[AElementIdx].Value; + inherited Create(ARecordSeries); + FKind := ARecordSeries.FDef.Fields[AElementIdx].Value; FOffset := sizeof(TScalar.TValue) * AElementIdx; end; function TScalarRecordSeries.TMemberSeries.GetCount: Int64; begin - Result := FRecordSeries.Count; + Result := RecordSeries.Count; end; function TScalarRecordSeries.TMemberSeries.GetItems(Idx: Integer): TScalar; var P: TChunkArray.PT; begin - P := FRecordSeries.GetItemRef(Idx); + P := RecordSeries.GetItemRef(Idx); inc(PByte(P), FOffset); Result.Create(FKind, P^); end; +function TScalarRecordSeries.TMemberSeries.GetRecordSeries: TScalarRecordSeries; +begin + Result := TScalarRecordSeries(Controller); +end; + function TScalarRecordSeries.TMemberSeries.GetTotalCount: Int64; begin - Result := FRecordSeries.TotalCount; -end; - -function TScalarRecordSeries.TMemberSeries.QueryInterface(const IID: TGUID; out Obj): HResult; -begin - if GetInterface(IID, Obj) then - Result := S_OK - else - Result := E_NOINTERFACE; -end; - -function TScalarRecordSeries.TMemberSeries._AddRef: Integer; -begin - Result := FRecordSeries._AddRef; -end; - -function TScalarRecordSeries.TMemberSeries._Release: Integer; -begin - Result := FRecordSeries._Release; + Result := RecordSeries.TotalCount; end; { TScalarSeries } diff --git a/Src/Data/Myc.Data.Value.pas b/Src/Data/Myc.Data.Value.pas index da8c5ed..c6da2e2 100644 --- a/Src/Data/Myc.Data.Value.pas +++ b/Src/Data/Myc.Data.Value.pas @@ -11,20 +11,8 @@ uses Myc.Data.Keyword; type - TDataValueKind = ( - vkVoid, - vkScalar, - vkText, - vkKeyword, - vkSeries, - vkRecordSeries, - vkRecord, - vkManagedObject, - vkMethod, - vkInterface, - vkPointer, - vkGeneric - ); + TDataValueKind = + (vkVoid, vkScalar, vkText, vkSeries, vkRecordSeries, vkRecord, vkManagedObject, vkMethod, vkInterface, vkPointer, vkGeneric); TDataValue = record type @@ -60,7 +48,6 @@ type 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: IKeyword): TDataValue; overload; inline; class operator Implicit(const AValue: TDataValue.TFunc): TDataValue; overload; inline; class operator Implicit(const AValue: TObject): TDataValue; overload; inline; @@ -82,12 +69,10 @@ type class function FromRecordSeries(const AValue: IRecordSeries): TDataValue; static; inline; class function FromRecord(const [ref] AValue: TScalarRecord): TDataValue; static; inline; class function FromSeries(const AValue: ISeries): TDataValue; static; inline; - class function FromKeyword(const AValue: IKeyword): TDataValue; static; inline; function AsScalar: TScalar; inline; function AsMethod: TFunc; inline; function AsText: String; inline; - function AsKeyword: IKeyword; inline; function AsRecordSeries: IRecordSeries; inline; function AsRecord: TScalarRecord; inline; function AsSeries: ISeries; inline; @@ -187,13 +172,6 @@ begin Result := Pointer(FScalar.Value.AsInt64); end; -function TDataValue.AsKeyword: IKeyword; -begin - if (FKind <> vkKeyword) then - raise EInvalidCast.Create('Cannot read value as Keyword.'); - Result := IKeyword(FInterface); -end; - function TDataValue.AsRecord: TScalarRecord; begin if (FKind <> vkRecord) then @@ -248,7 +226,7 @@ begin case FKind of vkScalar: case FScalar.Kind of - TScalar.TKind.Ordinal: + TScalar.TKind.Ordinal, TScalar.TKind.Keyword: Result := TInterlocked .CompareExchange(FScalar.Value.AsInt64, NewValue.AsScalar.Value.AsInt64, Expected.AsScalar.Value.AsInt64) @@ -264,7 +242,7 @@ begin TInterlocked.CompareExchange(FScalar.Value.AsInt64, NewValue.AsScalar.Value.AsInt64, Expected.AsScalar.Value.AsInt64) = Expected.AsScalar.Value.AsInt64; - vkText, vkKeyword, vkSeries, vkRecordSeries, vkRecord, vkManagedObject, vkMethod, vkInterface, vkGeneric: + vkText, vkSeries, vkRecordSeries, vkRecord, vkManagedObject, vkMethod, vkInterface, vkGeneric: Result := IntfCompareExchange(FInterface, NewValue.FInterface, Expected.FInterface) = Expected.FInterface; end; end; @@ -281,12 +259,6 @@ begin Result.FInterface := TVal.Create(AValue); end; -class function TDataValue.FromKeyword(const AValue: IKeyword): TDataValue; -begin - Result.FKind := vkKeyword; - Result.FInterface := AValue; -end; - class function TDataValue.FromPtr(const AValue: Pointer): TDataValue; begin Assert(sizeof(Pointer) <= sizeof(Int64)); @@ -325,12 +297,6 @@ begin Result.FInterface := TVal.Create(AValue); end; -class operator TDataValue.Implicit(const AValue: IKeyword): TDataValue; -begin - Result.FKind := vkKeyword; - Result.FInterface := AValue; -end; - function TDataValue.GetIsVoid: Boolean; begin Result := FKind = vkVoid; @@ -364,12 +330,13 @@ begin case FKind of vkScalar: case FScalar.Kind of - TScalar.TKind.Ordinal: Result := TInterlocked.Exchange(FScalar.Value.AsInt64, NewValue.AsScalar.Value.AsInt64); + TScalar.TKind.Ordinal, TScalar.TKind.Keyword: + Result := TInterlocked.Exchange(FScalar.Value.AsInt64, NewValue.AsScalar.Value.AsInt64); TScalar.TKind.Float: Result := TInterlocked.Exchange(FScalar.Value.AsDouble, NewValue.AsScalar.Value.AsDouble); end; vkPointer: Result := TInterlocked.Exchange(FScalar.Value.AsInt64, NewValue.AsScalar.Value.AsInt64); - vkText, vkKeyword, vkSeries, vkRecordSeries, vkRecord, vkManagedObject, vkMethod, vkInterface, vkGeneric: + vkText, vkSeries, vkRecordSeries, vkRecord, vkManagedObject, vkMethod, vkInterface, vkGeneric: begin Result.FKind := FKind; Result.FInterface := IntfExchange(FInterface, NewValue.FInterface); @@ -386,7 +353,6 @@ begin case FKind of vkScalar: Result := FScalar.ToString; vkText: Result := '"' + AsText + '"'; - vkKeyword: Result := ':' + AsKeyword.Name; vkSeries: begin var series := AsSeries; @@ -490,7 +456,6 @@ begin vkVoid: Result := 'Void'; vkScalar: Result := 'Scalar'; vkText: Result := 'Text'; - vkKeyword: Result := 'Keyword'; vkSeries: Result := 'Series'; vkRecordSeries: Result := 'RecordSeries'; vkRecord: Result := 'Record'; diff --git a/Src/Myc.Utils.pas b/Src/Myc.Utils.pas index ccd7dc2..35c1e6a 100644 --- a/Src/Myc.Utils.pas +++ b/Src/Myc.Utils.pas @@ -18,6 +18,18 @@ type class operator Implicit(const Upvalue: TManaged): T; overload; end; + TGenericContainedObject = class(TObject, IInterface) + private + FController: TInterfacedObject; + protected + function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall; + function _AddRef: Integer; stdcall; + function _Release: Integer; stdcall; + property Controller: TInterfacedObject read FController; + public + constructor Create(AController: TInterfacedObject); + end; + implementation constructor TManaged.TObj.Create(AValue: T); @@ -42,4 +54,30 @@ begin Result := (Upvalue.FIntf as TObj).FValue; end; +constructor TGenericContainedObject.Create(AController: TInterfacedObject); +begin + inherited Create; + FController := AController; +end; + +{ TGenericContainedObject } + +function TGenericContainedObject.QueryInterface(const IID: TGUID; out Obj): HResult; +begin + if GetInterface(IID, Obj) then + Result := S_OK + else + Result := E_NOINTERFACE; +end; + +function TGenericContainedObject._AddRef: Integer; +begin + Result := IInterface(FController)._AddRef; +end; + +function TGenericContainedObject._Release: Integer; +begin + Result := IInterface(FController)._Release; +end; + end.