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 
Script enhancements
This commit is contained in:
Michael Schimmel
2025-11-01 00:56:59 +01:00
parent 689dede600
commit 957171f089
7 changed files with 498 additions and 78 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/AST/Myc.Ast.Binding.pas
+75 -24
View File
@@ -161,6 +161,15 @@ type
property Definition: IScalarRecordDefinition read FDefinition;
end;
// Represents a bound record literal that maps to a generic (non-scalar) record
TBoundGenericRecordLiteralNode = class(TRecordLiteralNode)
private
FDefinition: IGenericRecordDefinition;
public
constructor Create(const AFields: TArray<TRecordFieldLiteral>; const ADef: IGenericRecordDefinition);
property Definition: IGenericRecordDefinition read FDefinition;
end;
implementation
uses
@@ -340,6 +349,13 @@ begin
FIsTailCall := AIsTailCall;
end;
{ TBoundGenericRecordLiteralNode }
constructor TBoundGenericRecordLiteralNode.Create(const AFields: TArray<TRecordFieldLiteral>; const ADef: IGenericRecordDefinition);
begin
inherited Create(AFields);
FDefinition := ADef;
end;
{ TBoundRecordLiteralNode }
constructor TBoundRecordLiteralNode.Create(const AFields: TArray<TRecordFieldLiteral>; const ADef: IScalarRecordDefinition);
begin
@@ -932,20 +948,35 @@ begin
elemType := TTypes.Unknown;
if (baseType.Kind <> TStaticTypeKind.stUnknown) then
begin
if (baseType.Kind <> TStaticTypeKind.stRecord) and (baseType.Kind <> TStaticTypeKind.stRecordSeries) then
raise ETypeException.CreateFmt('Member access requires a record or record series, but got %s', [baseType.ToString]);
if (baseType.Kind = TStaticTypeKind.stRecord) or (baseType.Kind = TStaticTypeKind.stRecordSeries) then
begin
// --- SALAR PATH ---
fieldIndex := baseType.Definition.IndexOf(Node.Member.Value);
if fieldIndex < 0 then
raise ETypeException.CreateFmt('Member "%s" not found in type %s', [Node.Member.Value.Name, baseType.ToString]);
// Use IndexOf(string) which correctly delegates to IndexOf(IKeyword)
fieldIndex := baseType.Definition.IndexOf(Node.Member.Value);
if fieldIndex < 0 then
raise ETypeException.CreateFmt('Member "%s" not found in type %s', [Node.Member.Value.Name, baseType.ToString]);
var fieldType := TTypes.FromScalarKind(baseType.Definition.Fields[fieldIndex].Value);
var fieldType := TTypes.FromScalarKind(baseType.Definition.Fields[fieldIndex].Value);
if baseType.Kind = TStaticTypeKind.stRecord then
elemType := fieldType
else // stRecordSeries
elemType := TTypes.CreateSeries(fieldType);
end
else if (baseType.Kind = TStaticTypeKind.stGenericRecord) then
begin
// --- GENERIC PATH ---
var genDef := baseType.GenericDefinition;
fieldIndex := genDef.IndexOf(Node.Member.Value);
if fieldIndex < 0 then
raise ETypeException.CreateFmt('Member "%s" not found in type %s', [Node.Member.Value.Name, baseType.ToString]);
if baseType.Kind = TStaticTypeKind.stRecord then
elemType := fieldType
else // stRecordSeries
elemType := TTypes.CreateSeries(fieldType);
// Type is stored directly in the generic definition
elemType := genDef.Fields[fieldIndex].Value;
end
else
begin
raise ETypeException.CreateFmt('Member access requires a record type, but got %s', [baseType.ToString]);
end;
end;
var boundNode := TAst.MemberAccess(baseNode, Node.Member);
@@ -956,24 +987,25 @@ function TAstBinder.VisitRecordLiteral(const Node: IRecordLiteralNode): TDataVal
var
i: Integer;
boundFields: TArray<TRecordFieldLiteral>;
defFields: TArray<TScalarRecordField>;
scalarDefFields: TArray<TScalarRecordField>; // Renamed
def: IScalarRecordDefinition;
staticType: IStaticType;
boundNode: IRecordLiteralNode;
valNode: IAstNode;
valType: IStaticType;
scalarKind: TScalar.TKind;
allScalar: Boolean; // Added
begin
FNextIsTail := False;
SetLength(boundFields, Length(Node.Fields));
SetLength(defFields, Length(Node.Fields));
SetLength(scalarDefFields, Length(Node.Fields)); // Renamed
allScalar := True; // Added
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 now store Ordinal, Float, or Keyword
// Check if this field fits the scalar path
if (valType.Kind = stOrdinal) then
scalarKind := TScalar.TKind.Ordinal
else if (valType.Kind = stFloat) then
@@ -981,21 +1013,40 @@ begin
else if (valType.Kind = stKeyword) then
scalarKind := TScalar.TKind.Keyword
else
raise ETypeException.CreateFmt(
'Record fields must be scalar (Ordinal, Float, or Keyword), but field ":%s" is %s',
[Node.Fields[i].Key.Value.Name, valType.ToString]);
begin
allScalar := False; // It's a generic record
scalarKind := TScalar.TKind.Ordinal; // Dummy value, won't be used
end;
boundFields[i] := TRecordFieldLiteral.Create(Node.Fields[i].Key, valNode);
// Create the definition field using the Keyword and its TScalar.TKind
defFields[i] := TScalarRecordField.Create(Node.Fields[i].Key.Value, scalarKind);
// Conditionally fill the scalar definition array
if allScalar then
scalarDefFields[i] := TScalarRecordField.Create(Node.Fields[i].Key.Value, scalarKind);
end;
def := TScalarRecordRegistry.Intern(defFields);
staticType := TTypes.CreateRecord(def);
boundNode := TBoundRecordLiteralNode.Create(boundFields, def);
// Now, create the correct bound node based on the flag
if allScalar then
begin
// --- EXISTING SCALAR PATH ---
def := TScalarRecordRegistry.Intern(scalarDefFields);
staticType := TTypes.CreateRecord(def);
var boundNode := TBoundRecordLiteralNode.Create(boundFields, def); // Old bound node
Result := SetType(TDataValue.FromIntf<IRecordLiteralNode>(boundNode), staticType);
end
else
begin
// --- NEW GENERIC PATH ---
var genDefFields: TArray<TPair<IKeyword, IStaticType>>;
SetLength(genDefFields, Length(boundFields));
for i := 0 to High(boundFields) do
genDefFields[i] := TPair<IKeyword, IStaticType>.Create(boundFields[i].Key.Value, (boundFields[i].Value as TAstNode).StaticType);
Result := SetType(TDataValue.FromIntf<IRecordLiteralNode>(boundNode), staticType);
var genDef := TGenericRecordRegistry.Intern(genDefFields);
staticType := TTypes.CreateGenericRecord(genDef);
var genBoundNode := TBoundGenericRecordLiteralNode.Create(boundFields, genDef);
Result := SetType(TDataValue.FromIntf<IRecordLiteralNode>(genBoundNode), staticType);
end;
end;
function TAstBinder.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue;
Src/AST/Myc.Ast.Evaluator.pas
+91 -26
View File
@@ -18,6 +18,7 @@ type
TEvaluatorVisitor = class(TAstVisitor, IEvaluatorVisitor)
private
FScope: IExecutionScope;
class var
procedure HandleTCO(var ResultValue: TDataValue);
protected
@@ -77,13 +78,15 @@ type
TThunk = record
Callee: TDataValue;
Args: TArray<TDataValue>;
constructor Create(const ACallee: TDataValue; const AArgs: TArray<TDataValue>);
Recur: Boolean;
constructor Create(const ACallee: TDataValue; const AArgs: TArray<TDataValue>; ARecur: Boolean);
end;
constructor TThunk.Create(const ACallee: TDataValue; const AArgs: TArray<TDataValue>);
constructor TThunk.Create(const ACallee: TDataValue; const AArgs: TArray<TDataValue>; ARecur: Boolean);
begin
Callee := ACallee;
Args := AArgs;
Recur := ARecur;
end;
// --- Native Functions Implementation ---
@@ -114,6 +117,41 @@ begin
AScope.Define('CreateRecordSeries', TDataValue(NativeCreateRecordSeries));
end;
{ TDynamicRecord }
type
// Runtime implementation for generic records using linear search
TDynamicRecord = class(TInterfacedObject, IKeywordMapping<TDataValue>)
private
FFields: TArray<TPair<IKeyword, TDataValue>>;
function GetFields: TArray<TPair<IKeyword, TDataValue>>;
public
constructor Create(const AFields: TArray<TPair<IKeyword, TDataValue>>);
function IndexOf(const Key: IKeyword): Integer;
end;
constructor TDynamicRecord.Create(const AFields: TArray<TPair<IKeyword, TDataValue>>);
begin
inherited Create;
FFields := AFields;
end;
function TDynamicRecord.GetFields: TArray<TPair<IKeyword, TDataValue>>;
begin
Result := FFields;
end;
function TDynamicRecord.IndexOf(const Key: IKeyword): Integer;
begin
// Linear search (O(n)) as requested
for Result := 0 to High(FFields) do
begin
if FFields[Result].Key.Idx = Key.Idx then
exit;
end;
Result := -1;
end;
{ TEvaluatorVisitor }
constructor TEvaluatorVisitor.Create(const AScope: IExecutionScope);
@@ -279,12 +317,13 @@ begin
if boundNode.IsTailCall then
begin
// This is a tail call. Return a thunk to be processed by the trampoline.
Result := TDataValue.FromGeneric<TThunk>(TThunk.Create(calleeValue, argValues));
Result := TDataValue.FromGeneric<TThunk>(TThunk.Create(calleeValue, argValues, false));
end
else
begin
// This is a non-tail call. It must execute the call and act as the trampoline.
Result := (calleeValue.AsMethod)(argValues);
HandleTCO(Result);
end;
end;
@@ -315,7 +354,7 @@ begin
calleeValue := FScope[calleeAddress];
// Recur always returns a thunk for the trampoline.
Result := TDataValue.FromGeneric<TThunk>(TThunk.Create(calleeValue, argValues));
Result := TDataValue.FromGeneric<TThunk>(TThunk.Create(calleeValue, argValues, true));
end;
function TEvaluatorVisitor.VisitAddSeriesItem(const Node: IAddSeriesItemNode): TDataValue;
@@ -446,7 +485,19 @@ begin
case baseValue.Kind of
vkRecordSeries: Result := TDataValue.FromSeries(baseValue.AsRecordSeries[Node.Member.Value]);
vkRecord: Result := baseValue.AsRecord[Node.Member.Value];
// --- NEW GENERIC PATH ---
vkGenericRecord:
begin
var rec := baseValue.AsGenericRecord;
var fieldIndex := rec.IndexOf(Node.Member.Value);
if fieldIndex < 0 then
raise EArgumentException.CreateFmt('Member ":%s" not found in record.', [Node.Member.Value.Name]);
Result := rec.Fields[fieldIndex].Value;
end;
else
raise EArgumentException.Create('Member access operator `.` is not supported for this value type.');
end;
@@ -454,35 +505,49 @@ end;
function TEvaluatorVisitor.VisitRecordLiteral(const Node: IRecordLiteralNode): TDataValue;
var
boundNode: TBoundRecordLiteralNode;
values: TArray<TScalar.TValue>;
i: Integer;
valData: TDataValue;
begin
// The node must be a bound node from the binder
boundNode := Node as TBoundRecordLiteralNode;
SetLength(values, Length(boundNode.Fields));
for i := 0 to High(boundNode.Fields) do
// Check which type the binder created
if Node is TBoundGenericRecordLiteralNode then
begin
// Evaluate the value expression for this field
valData := boundNode.Fields[i].Value.Accept(Self);
// --- NEW GENERIC PATH ---
var boundNode := Node as TBoundGenericRecordLiteralNode;
var genFields: TArray<TPair<IKeyword, TDataValue>>;
SetLength(genFields, Length(boundNode.Fields));
if valData.Kind = vkScalar then
// Evaluate all field values
for i := 0 to High(boundNode.Fields) do
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.');
genFields[i] :=
TPair<IKeyword, TDataValue>.Create(
boundNode.Fields[i].Key.Value,
boundNode.Fields[i].Value.Accept(Self) // Evaluate expression
);
end;
end;
// Create the TScalarRecord using the definition from the binder
var rec := TScalarRecord.Create(boundNode.Definition, values);
Result := TDataValue.FromRecord(rec);
// Create the new runtime object and wrap it
var dynRec := TDynamicRecord.Create(genFields);
Result := TDataValue.FromGenericRecord(dynRec);
end
else if Node is TBoundRecordLiteralNode then
begin
// --- EXISTING SCALAR PATH ---
var boundNode := Node as TBoundRecordLiteralNode;
var values: TArray<TScalar.TValue>;
SetLength(values, Length(boundNode.Fields));
for i := 0 to High(boundNode.Fields) do
begin
var valData := boundNode.Fields[i].Value.Accept(Self);
// Binder guarantees these are vkScalar
values[i] := valData.AsScalar.Value;
end;
var rec := TScalarRecord.Create(boundNode.Definition, values);
Result := TDataValue.FromRecord(rec);
end
else
raise EInvalidOpException.Create('Unknown record literal node type during evaluation.');
end;
function TEvaluatorVisitor.VisitVariableDeclaration(const Node: IVariableDeclarationNode): TDataValue;
Src/AST/Myc.Ast.Script.pas
+153 -13
View File
@@ -7,6 +7,90 @@ uses
Myc.Ast.Nodes,
Myc.Ast.Visitor;
var
// This BNF should always be kept up to date and valid. It is used to comunicate with LLMs.
BNF: String =
'''
(* ---------------------------------------------------------------------- *)
(* ---- Main Productions (Start Symbols) ---- *)
(* ---------------------------------------------------------------------- *)
(* A program is a single expression, which can be followed by comments *)
program ::= expression
(* An expression is either an atom, a list, a record, or a macro character *)
expression ::= atom | list | record_literal | reader_macro
(* ---------------------------------------------------------------------- *)
(* ---- Atoms (Basic Values) ---- *)
(* ---------------------------------------------------------------------- *)
atom ::= number | string | identifier | keyword
(* ---------------------------------------------------------------------- *)
(* ---- Reader-Macros (Syntactic Sugar) ---- *)
(* ---------------------------------------------------------------------- *)
reader_macro ::= "'" expression (* (quote ...) *)
| "`" expression (* (quasiquote ...) *)
| "~" expression (* (unquote ...) *)
| "~@" expression (* (unquote-splicing ...) *)
(* ---------------------------------------------------------------------- *)
(* ---- Lists (S-Expressions) ---- *)
(* ---------------------------------------------------------------------- *)
(* A list is the primary structure for code. Empty lists () are invalid. *)
list ::= "(" list_content ")"
(* The parser distinguishes between special forms (like 'if') and
general function calls based on the first element. *)
list_content ::= special_form | function_call
special_form ::= "if" expression expression expression?
| "?" expression expression expression
| "def" identifier expression?
| "defmacro" identifier parameter_list expression
| "assign" identifier expression
| "fn" parameter_list expression
| "do" expression*
| "recur" expression*
| "get" expression expression
| dot_identifier expression
(* A function call is any list not recognized as a special form.
The first 'expression' is the callee, the rest are the arguments. *)
function_call ::= expression expression*
(* ---------------------------------------------------------------------- *)
(* ---- Parameter Lists and Records ---- *)
(* ---------------------------------------------------------------------- *)
(* A parameter list is *only* valid inside 'fn' and 'defmacro' *)
parameter_list ::= "[" identifier* "]"
(* A record literal consists of 0 or more keyword/value pairs *)
record_literal ::= "{" (keyword expression)* "}"
(* ---------------------------------------------------------------------- *)
(* ---- Terminals (Lexer Tokens) ---- *)
(* ---------------------------------------------------------------------- *)
number ::= ["-"] digit+ ["." digit+]
string ::= '"' ( ? any char except \ or " ? | '\' ( '"' | '\' | 'n' | 'r' | 't' ) )* '"'
keyword ::= ":" identifier
(* An identifier for member access, handled specially by the parser *)
dot_identifier ::= "." identifier
(* An identifier is a sequence of characters that are not delimiters.
The lexer is very permissive. *)
identifier ::= ? any sequence of chars not containing whitespace, '()[]{}'`~:; ?
digit ::= "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9"
''';
type
// Provides a high-level facade for parsing and printing the AST.
TAstScript = record
@@ -164,8 +248,8 @@ var
startPos: Integer;
begin
startPos := FCurrentPos;
// Reader macro characters are now also delimiters for identifiers.
while (Peek <> #0) and (not (Peek.IsWhiteSpace or CharInSet(Peek, ['(', ')', '[', ']', '{', '}', '''', '`', '~']))) do
// Reader macro characters and comments are now also delimiters for identifiers.
while (Peek <> #0) and (not (Peek.IsWhiteSpace or CharInSet(Peek, ['(', ')', '[', ']', '{', '}', '''', '`', '~', ';']))) do
Advance;
Result := Copy(FSource, startPos, FCurrentPos - startPos);
end;
@@ -175,6 +259,11 @@ var
startPos: Integer;
begin
startPos := FCurrentPos;
// Handle the optional leading minus sign
if (Peek = '-') then
Advance;
while (Peek <> #0) and (Peek.IsDigit or (Peek = '.')) do
Advance;
Result := Copy(FSource, startPos, FCurrentPos - startPos);
@@ -182,15 +271,57 @@ end;
function TLexer.ReadString: string;
var
startPos: Integer;
builder: TStringBuilder;
c: Char;
begin
Advance; // Skip opening "
startPos := FCurrentPos;
while (Peek <> #0) and (Peek <> '"') do
Advance;
Result := Copy(FSource, startPos, FCurrentPos - startPos);
if Peek = '"' then
Advance; // Skip closing "
builder := TStringBuilder.Create;
try
while (FCurrentPos <= Length(FSource)) do
begin
c := Peek;
if c = '"' then
begin
Advance; // Consume closing "
Result := builder.ToString;
exit;
end;
if c = '\' then
begin
Advance; // Consume '\'
if FCurrentPos > Length(FSource) then
raise Exception.Create('Syntax Error: String literal ends with an escape character.');
c := Peek; // Get escaped char
case c of
'"': builder.Append('"');
'\': builder.Append('\');
'n': builder.Append(sLineBreak); // Use system's line break
't': builder.Append(#9);
'r': builder.Append(#13);
else
// Pass through unknown escapes (e.g., "\z" becomes "z")
builder.Append(c);
end;
Advance; // Consume escaped char
end
else
begin
// Append regular char (including literal newlines)
if c = #0 then // Check for unexpected EOF
break;
builder.Append(c);
Advance;
end;
end;
// If we fall out of the loop, we hit EOF without a closing quote.
raise Exception.Create('Syntax Error: Unterminated string literal.');
finally
builder.Free;
end;
end;
function TLexer.GetNextToken: TToken;
@@ -473,6 +604,8 @@ begin
end
else if SameText(head.Token.Text, 'assign') then
begin
if Length(tailNodes) <> 2 then
raise Exception.Create('Syntax Error: ''assign'' requires exactly 2 arguments (identifier and value).');
if tailTokens[0].Kind <> tkIdentifier then
raise Exception.Create('Syntax Error: Expected an identifier for assignment.');
Result := TAst.Assign(IIdentifierNode(tailNodes[0]), tailNodes[1]);
@@ -488,9 +621,19 @@ begin
else if SameText(head.Token.Text, 'recur') then
Result := TAst.Recur(tailNodes)
else if SameText(head.Token.Text, 'get') then
begin
if Length(tailNodes) <> 2 then
raise Exception.Create('Syntax Error: ''get'' requires exactly 2 arguments (base and index).');
Result := TAst.Indexer(tailNodes[0], tailNodes[1])
end
else if (Length(head.Token.Text) > 1) and (head.Token.Text.StartsWith('.')) then
begin
if Length(tailNodes) <> 1 then
raise Exception.CreateFmt(
'Syntax Error: Member access (e.g., ''%s'') requires exactly 1 argument (the base object).',
[head.Token.Text]);
Result := TAst.MemberAccess(tailNodes[0], TAst.Keyword(head.Token.Text.Substring(1)));
end;
end;
// If no special form matched, treat it as a generic function call.
@@ -553,7 +696,7 @@ begin
Result.Node :=
TAst.Constant(i64)
// Use invariant format settings for float parsing.
else if TryStrToFloat(FCurrentToken.Text, dbl) then
else if TryStrToFloat(FCurrentToken.Text, dbl, TFormatSettings.Invariant) then
Result.Node := TAst.Constant(dbl)
else
raise Exception.CreateFmt('Syntax Error: Invalid number format "%s"', [FCurrentToken.Text]);
@@ -1009,7 +1152,4 @@ begin
end;
end;
initialization
FormatSettings.DecimalSeparator := '.';
end.
Src/AST/Myc.Ast.Types.pas
+105 -1
View File
@@ -22,7 +22,8 @@ type
stMethod,
stSeries,
stRecord,
stRecordSeries
stRecordSeries,
stGenericRecord
);
TStaticTypeKindHelper = record helper for TStaticTypeKind
@@ -40,6 +41,10 @@ type
property ReturnType: IStaticType read GetReturnType;
end;
// Defines a mapping for generic record fields (Key -> StaticType)
IGenericRecordDefinition = IKeywordMapping<IStaticType>;
TGenericRecordRegistry = TKeywordMappingRegistry<IStaticType>;
// Represents a complete static type definition.
IStaticType = interface
{$region 'private'}
@@ -47,6 +52,7 @@ type
function GetElementType: IStaticType;
function GetSignature: IMethodSignature;
function GetDefinition: IScalarRecordDefinition;
function GetGenericDefinition: IGenericRecordDefinition;
{$endregion}
// The kind of type (e.g., Ordinal, Series, etc.)
@@ -57,6 +63,8 @@ type
property Signature: IMethodSignature read GetSignature;
// The definition (if Kind = stRecord or stRecordSeries)
property Definition: IScalarRecordDefinition read GetDefinition;
// The definition (if Kind = stGenericRecord)
property GenericDefinition: IGenericRecordDefinition read GetGenericDefinition;
// Checks for type equality
function IsEqual(const Other: IStaticType): Boolean;
@@ -96,6 +104,7 @@ type
class function CreateMethod(const AParamTypes: TArray<IStaticType>; const AReturnType: IStaticType): IStaticType; static;
class function CreateRecord(const ADef: IScalarRecordDefinition): IStaticType; static;
class function CreateRecordSeries(const ADef: IScalarRecordDefinition): IStaticType; static;
class function CreateGenericRecord(const ADef: IGenericRecordDefinition): IStaticType; static;
class function FromScalarKind(AKind: TScalar.TKind): IStaticType; static;
end;
@@ -134,6 +143,7 @@ begin
stSeries: Result := 'Series';
stRecord: Result := 'Record';
stRecordSeries: Result := 'RecordSeries';
stGenericRecord: Result := 'GenericRecord'; // Added
else
Result := 'ErrorType';
end;
@@ -149,6 +159,7 @@ type
function GetElementType: IStaticType; virtual;
function GetSignature: IMethodSignature; virtual;
function GetDefinition: IScalarRecordDefinition; virtual;
function GetGenericDefinition: IGenericRecordDefinition; virtual; // Added
function IsEqual(const Other: IStaticType): Boolean; virtual;
function ToString: string; override;
end;
@@ -169,6 +180,12 @@ begin
Result := Default(IScalarRecordDefinition);
end;
// Added
function TAbstractStaticType.GetGenericDefinition: IGenericRecordDefinition;
begin
Result := nil;
end;
function TAbstractStaticType.IsEqual(const Other: IStaticType): Boolean;
begin
// Default implementation: types are equal if their kinds are equal.
@@ -343,6 +360,7 @@ end;
// ---
type
// Represents stRecord and stRecordSeries (Scalar Records)
TRecordType = class(TAbstractStaticType)
private
FKind: TStaticTypeKind;
@@ -414,6 +432,78 @@ begin
Result := Result + '}';
end;
// ---
// Added: Represents stGenericRecord
type
TGenericRecordType = class(TAbstractStaticType)
private
FDefinition: IGenericRecordDefinition;
public
constructor Create(const ADef: IGenericRecordDefinition);
function GetKind: TStaticTypeKind; override;
function GetGenericDefinition: IGenericRecordDefinition; override;
function IsEqual(const Other: IStaticType): Boolean; override;
function ToString: string; override;
end;
constructor TGenericRecordType.Create(const ADef: IGenericRecordDefinition);
begin
inherited Create;
FDefinition := ADef;
end;
function TGenericRecordType.GetKind: TStaticTypeKind;
begin
Result := stGenericRecord;
end;
function TGenericRecordType.GetGenericDefinition: IGenericRecordDefinition;
begin
Result := FDefinition;
end;
function TGenericRecordType.IsEqual(const Other: IStaticType): Boolean;
var
i: Integer;
begin
if (not Assigned(Other)) or (Other.Kind <> stGenericRecord) then
exit(False);
var otherDef := Other.GenericDefinition;
if (not Assigned(Self.FDefinition)) or (not Assigned(otherDef)) then
exit(False);
if Length(Self.FDefinition.Fields) <> Length(otherDef.Fields) then
exit(False);
for i := 0 to High(Self.FDefinition.Fields) do
begin
// Compare keys (fast) and static types (must use IsEqual)
if (Self.FDefinition.Fields[i].Key <> otherDef.Fields[i].Key)
or (not Self.FDefinition.Fields[i].Value.IsEqual(otherDef.Fields[i].Value)) then
exit(False);
end;
Result := True;
end;
function TGenericRecordType.ToString: string;
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;
{ TTypes (Factory) }
class constructor TTypes.Create;
@@ -442,6 +532,12 @@ begin
Result := TRecordType.Create(stRecordSeries, ADef);
end;
// Added
class function TTypes.CreateGenericRecord(const ADef: IGenericRecordDefinition): IStaticType;
begin
Result := TGenericRecordType.Create(ADef);
end;
class function TTypes.CreateSeries(const AElementType: IStaticType): IStaticType;
begin
Result := TSeriesType.Create(AElementType);
@@ -484,6 +580,9 @@ begin
// TODO: Implement full assignment compatibility rules (e.g., for records/series)
// Allow assigning a scalar record to a generic record? (Maybe later)
// Allow assigning a generic record to a scalar record? (If fields match)
Result := False;
end;
@@ -513,6 +612,10 @@ begin
if A.IsEqual(B) then
exit(A);
// Cannot promote stGenericRecord or stRecord with anything other than itself/unknown
if (A.Kind in [stRecord, stGenericRecord]) or (B.Kind in [stRecord, stGenericRecord]) then
raise ETypeException.CreateFmt('Cannot promote types %s and %s', [A.ToString, B.ToString]);
// Cannot promote other combinations (e.g., Ordinal and Keyword)
raise ETypeException.CreateFmt('Cannot promote types %s and %s', [A.ToString, B.ToString]);
end;
@@ -562,6 +665,7 @@ begin
TScalar.TBinaryOp.Equal, TScalar.TBinaryOp.NotEqual:
begin
// Allow equality checks for Ordinal, Float, or Keyword
// (Records are not yet supported for equality)
if not (promotedKind in [stOrdinal, stFloat, stKeyword]) then
raise ETypeException.CreateFmt(
'Comparison operator %s requires Ordinal, Float, or Keyword, but got %s after promotion',
Src/Data/Myc.Data.Keyword.pas
+10 -9
View File
@@ -34,7 +34,7 @@ type
class var
FLock: TSpinLock;
class var
FRegistry: TDictionary<string, IKeyword>;
FRegistry: TDictionary<string, Integer>;
class var
FReverseMap: TList<IKeyword>; // Use TList
class constructor Create;
@@ -116,7 +116,7 @@ end;
class constructor TKeywordRegistry.Create;
begin
FLock := TSpinLock.Create(false);
FRegistry := TDictionary<string, IKeyword>.Create;
FRegistry := TDictionary<string, Integer>.Create;
FReverseMap := TList<IKeyword>.Create;
Intern('false');
@@ -135,24 +135,25 @@ begin
try
// Check bounds
if (AIdx >= 0) and (AIdx < FReverseMap.Count) then
Result := FReverseMap[AIdx].Name
else
Result := ''; // Return empty for safety
Result := FReverseMap[AIdx].Name;
finally
FLock.Exit;
end;
end;
class function TKeywordRegistry.Intern(const AName: string): IKeyword;
var
idx: Integer;
begin
FLock.Enter;
try
if not FRegistry.TryGetValue(AName, Result) then
if not FRegistry.TryGetValue(AName, idx) then
begin
Result := TKeyword.Create(AName, FRegistry.Count);
FReverseMap.Add(Result); // Add to reverse map (Idx -> Interface)
FRegistry.Add(AName, Result); // Add to forward map (Name -> Interface)
end;
FRegistry.Add(AName, FReverseMap.Add(Result));
end
else
Result := FReverseMap[idx];
finally
FLock.Exit;
end;
Src/Data/Myc.Data.Scalar.pas
+1 -1
View File
@@ -319,7 +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);
TKind.Keyword: Result := ':' + TKeywordRegistry.GetName(Value.AsInt64);
else
Result := '[Unknown Scalar]';
end;
Src/Data/Myc.Data.Value.pas
+63 -4
View File
@@ -5,14 +5,27 @@ interface
uses
System.SysUtils,
System.SyncObjs,
System.Generics.Collections, // Added for TDictionary
Myc.Utils,
Myc.Data.Scalar,
Myc.Data.Series,
Myc.Data.Keyword;
type
TDataValueKind =
(vkVoid, vkScalar, vkText, vkSeries, vkRecordSeries, vkRecord, vkManagedObject, vkMethod, vkInterface, vkPointer, vkGeneric);
TDataValueKind = (
vkVoid,
vkScalar,
vkText,
vkSeries,
vkRecordSeries,
vkRecord,
vkGenericRecord, // Added
vkManagedObject,
vkMethod,
vkInterface,
vkPointer,
vkGeneric
);
TDataValue = record
type
@@ -68,6 +81,7 @@ type
class function FromRecordSeries(const AValue: IRecordSeries): TDataValue; static; inline;
class function FromRecord(const [ref] AValue: TScalarRecord): TDataValue; static; inline;
class function FromGenericRecord(const AValue: IKeywordMapping<TDataValue>): TDataValue; static; inline;
class function FromSeries(const AValue: ISeries): TDataValue; static; inline;
function AsScalar: TScalar; inline;
@@ -75,6 +89,7 @@ type
function AsText: String; inline;
function AsRecordSeries: IRecordSeries; inline;
function AsRecord: TScalarRecord; inline;
function AsGenericRecord: IKeywordMapping<TDataValue>; inline;
function AsSeries: ISeries; inline;
function AsObject: TObject; overload; inline;
@@ -179,6 +194,14 @@ begin
Result := (FInterface as TVal<TScalarRecord>).Value;
end;
// Added
function TDataValue.AsGenericRecord: IKeywordMapping<TDataValue>;
begin
if (FKind <> vkGenericRecord) then
raise EInvalidCast.Create('Cannot read value as GenericRecord.');
Result := IKeywordMapping<TDataValue>(FInterface);
end;
function TDataValue.AsRecordSeries: IRecordSeries;
begin
if (FKind <> vkRecordSeries) then
@@ -242,7 +265,8 @@ begin
TInterlocked.CompareExchange(FScalar.Value.AsInt64, NewValue.AsScalar.Value.AsInt64, Expected.AsScalar.Value.AsInt64)
= Expected.AsScalar.Value.AsInt64;
vkText, vkSeries, vkRecordSeries, vkRecord, vkManagedObject, vkMethod, vkInterface, vkGeneric:
// Added vkGenericRecord
vkText, vkSeries, vkRecordSeries, vkRecord, vkGenericRecord, vkManagedObject, vkMethod, vkInterface, vkGeneric:
Result := IntfCompareExchange(FInterface, NewValue.FInterface, Expected.FInterface) = Expected.FInterface;
end;
end;
@@ -278,6 +302,13 @@ begin
Result.FInterface := TVal<TScalarRecord>.Create(AValue);
end;
// Added
class function TDataValue.FromGenericRecord(const AValue: IKeywordMapping<TDataValue>): TDataValue;
begin
Result.FKind := vkGenericRecord;
Result.FInterface := AValue;
end;
class function TDataValue.FromRecordSeries(const AValue: IRecordSeries): TDataValue;
begin
Result.FKind := vkRecordSeries;
@@ -336,7 +367,8 @@ begin
end;
vkPointer: Result := TInterlocked.Exchange(FScalar.Value.AsInt64, NewValue.AsScalar.Value.AsInt64);
vkText, vkSeries, vkRecordSeries, vkRecord, vkManagedObject, vkMethod, vkInterface, vkGeneric:
// Added vkGenericRecord
vkText, vkSeries, vkRecordSeries, vkRecord, vkGenericRecord, vkManagedObject, vkMethod, vkInterface, vkGeneric:
begin
Result.FKind := FKind;
Result.FInterface := IntfExchange(FInterface, NewValue.FInterface);
@@ -348,6 +380,7 @@ function TDataValue.ToString: String;
var
sb: TStringBuilder;
field: TScalarRecordField;
genField: TPair<IKeyword, TDataValue>; // Added
first: Boolean;
begin
case FKind of
@@ -401,6 +434,27 @@ begin
sb.Free;
end;
end;
// Added
vkGenericRecord:
begin
var rec := AsGenericRecord;
sb := TStringBuilder.Create;
try
sb.Append('{');
first := True;
for genField in rec.Fields do
begin
if not first then
sb.Append(',');
sb.Append(genField.Key.Name);
first := False;
end;
sb.Append('}');
Result := Format('<generic_record%s>', [sb.ToString]);
finally
sb.Free;
end;
end;
vkVoid: Result := '<void>';
vkMethod: Result := '<method>';
vkGeneric:
@@ -459,7 +513,12 @@ begin
vkSeries: Result := 'Series';
vkRecordSeries: Result := 'RecordSeries';
vkRecord: Result := 'Record';
vkGenericRecord: Result := 'GenericRecord'; // Added
vkMethod: Result := 'Method';
vkInterface: Result := 'Interface';
vkPointer: Result := 'Pointer';
vkGeneric: Result := 'Generic';
vkManagedObject: Result := 'ManagedObject';
else
Result := 'unknown';
end;