Brummel/MycLib
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects 1 Releases Wiki Activity

Keywords as basic scalar type

Browse Source
This commit is contained in:
Michael Schimmel
2025-10-31 21:15:08 +01:00
parent 8abec8e98f
commit 689dede600
9 changed files with 292 additions and 264 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/AST/Myc.Ast.Binding.pas
+15 -21
View File
@@ -259,13 +259,9 @@ 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<IAstNode>(TAst.Keyword(value.AsKeyword.Name))
else
Result := TDataValue.FromIntf<IAstNode>(TAst.Constant(value));
end
else
@@ -795,7 +791,6 @@ begin
Result := SetType(TDataValue.FromIntf<IConstantNode>(Node), TTypes.FromScalarKind(Node.Value.AsScalar.Kind));
TDataValueKind.vkText: Result := SetType(TDataValue.FromIntf<IConstantNode>(Node), TTypes.Text);
TDataValueKind.vkVoid: Result := SetType(TDataValue.FromIntf<IConstantNode>(Node), TTypes.Void);
TDataValueKind.vkKeyword: Result := SetType(TDataValue.FromIntf<IConstantNode>(Node), TTypes.Keyword);
else
// Handle other constant types if they become supported
Result := SetType(TDataValue.FromIntf<IConstantNode>(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<IKeywordNode>(Node);
// We also set the static type on the node itself during binding.
Result := SetType(TDataValue.FromIntf<IKeywordNode>(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<IAstNode>;
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;
Src/AST/Myc.Ast.Evaluator.pas
+37 -39
View File
@@ -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)];
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
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(
Src/AST/Myc.Ast.JSON.pas
+10 -5
View File
@@ -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<TJSONNumber>('Value').AsInt64);
TScalar.TKind.Float: Result := TScalar.FromDouble(scalarObj.GetValue<TJSONNumber>('Value').AsDouble);
TScalar.TKind.Keyword:
// Keywords are serialized by name, intern them back
Result := TScalar.FromKeyword(TKeywordRegistry.Intern(scalarObj.GetValue<string>('Value')));
end;
end
else if SameText(kindStr, 'Text') then
begin
Result := valObj.GetValue<string>('Value');
end
else if SameText(kindStr, 'Keyword') then
begin
Result := TDataValue.FromKeyword(TKeywordRegistry.Intern(valObj.GetValue<string>('Value')));
end
else if SameText(kindStr, 'Void') then
begin
Result := TDataValue.Void;
Src/AST/Myc.Ast.Types.pas
+18 -12
View File
@@ -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,12 +402,15 @@ var
i: Integer;
begin
Result := GetKind.ToString + '{';
if Assigned(FDefinition) then
begin
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;
Src/AST/Myc.Ast.pas
+4 -4
View File
@@ -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;
Src/Data/Myc.Data.Keyword.pas
+27 -2
View File
@@ -35,11 +35,15 @@ type
FLock: TSpinLock;
class var
FRegistry: TDictionary<string, IKeyword>;
class var
FReverseMap: TList<IKeyword>; // 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<string, IKeyword>.Create;
FReverseMap := TList<IKeyword>.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<T>.Intern(const AFields: TArray<TPair<IKeyword, T>>): IKeywordMapping<T>;
var
key: TArray<Integer>;
newMapping: IKeywordMapping<T>;
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<T>;
newMapping := TKeywordMapping.Create(AFields) as IKeywordMapping<T>;
// 5. Lock again to add
FLock.Enter;
Src/Data/Myc.Data.Scalar.pas
+128 -131
View File
@@ -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<TScalarRecordSeries>, 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,38 +248,57 @@ 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
exit(False);
Result := True;
end;
@@ -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<TScalar.TValue>.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 }
Src/Data/Myc.Data.Value.pas
+7 -42
View File
@@ -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<T>.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<String>.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';
Src/Myc.Utils.pas
+38
View File
@@ -18,6 +18,18 @@ type
class operator Implicit(const Upvalue: TManaged<T>): T; overload;
end;
TGenericContainedObject<T: TInterfacedObject> = 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<T>.TObj.Create(AValue: T);
@@ -42,4 +54,30 @@ begin
Result := (Upvalue.FIntf as TObj).FValue;
end;
constructor TGenericContainedObject<T>.Create(AController: TInterfacedObject);
begin
inherited Create;
FController := AController;
end;
{ TGenericContainedObject }
function TGenericContainedObject<T>.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
if GetInterface(IID, Obj) then
Result := S_OK
else
Result := E_NOINTERFACE;
end;
function TGenericContainedObject<T>._AddRef: Integer;
begin
Result := IInterface(FController)._AddRef;
end;
function TGenericContainedObject<T>._Release: Integer;
begin
Result := IInterface(FController)._Release;
end;
end.