From 957171f089acfeeb44de216417f25eb1650d2bb9 Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Sat, 1 Nov 2025 00:56:59 +0100 Subject: [PATCH] Keywords as basic scalar type Script enhancements --- Src/AST/Myc.Ast.Binding.pas | 99 +++++++++++++++----- Src/AST/Myc.Ast.Evaluator.pas | 117 ++++++++++++++++++------ Src/AST/Myc.Ast.Script.pas | 166 +++++++++++++++++++++++++++++++--- Src/AST/Myc.Ast.Types.pas | 106 +++++++++++++++++++++- Src/Data/Myc.Data.Keyword.pas | 19 ++-- Src/Data/Myc.Data.Scalar.pas | 2 +- Src/Data/Myc.Data.Value.pas | 67 +++++++++++++- 7 files changed, 498 insertions(+), 78 deletions(-) diff --git a/Src/AST/Myc.Ast.Binding.pas b/Src/AST/Myc.Ast.Binding.pas index 57d6ba5..fa4d132 100644 --- a/Src/AST/Myc.Ast.Binding.pas +++ b/Src/AST/Myc.Ast.Binding.pas @@ -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; 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; const ADef: IGenericRecordDefinition); +begin + inherited Create(AFields); + FDefinition := ADef; +end; + { TBoundRecordLiteralNode } constructor TBoundRecordLiteralNode.Create(const AFields: TArray; 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; - defFields: TArray; + scalarDefFields: TArray; // 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; 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(boundNode), staticType); + end + else + begin + // --- NEW GENERIC PATH --- + var genDefFields: TArray>; + SetLength(genDefFields, Length(boundFields)); + for i := 0 to High(boundFields) do + genDefFields[i] := TPair.Create(boundFields[i].Key.Value, (boundFields[i].Value as TAstNode).StaticType); - Result := SetType(TDataValue.FromIntf(boundNode), staticType); + var genDef := TGenericRecordRegistry.Intern(genDefFields); + staticType := TTypes.CreateGenericRecord(genDef); + var genBoundNode := TBoundGenericRecordLiteralNode.Create(boundFields, genDef); + Result := SetType(TDataValue.FromIntf(genBoundNode), staticType); + end; end; function TAstBinder.VisitLambdaExpression(const Node: ILambdaExpressionNode): TDataValue; diff --git a/Src/AST/Myc.Ast.Evaluator.pas b/Src/AST/Myc.Ast.Evaluator.pas index 283f2fc..da1b842 100644 --- a/Src/AST/Myc.Ast.Evaluator.pas +++ b/Src/AST/Myc.Ast.Evaluator.pas @@ -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; - constructor Create(const ACallee: TDataValue; const AArgs: TArray); + Recur: Boolean; + constructor Create(const ACallee: TDataValue; const AArgs: TArray; ARecur: Boolean); end; -constructor TThunk.Create(const ACallee: TDataValue; const AArgs: TArray); +constructor TThunk.Create(const ACallee: TDataValue; const AArgs: TArray; 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) + private + FFields: TArray>; + function GetFields: TArray>; + public + constructor Create(const AFields: TArray>); + function IndexOf(const Key: IKeyword): Integer; + end; + +constructor TDynamicRecord.Create(const AFields: TArray>); +begin + inherited Create; + FFields := AFields; +end; + +function TDynamicRecord.GetFields: TArray>; +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.Create(calleeValue, argValues)); + Result := TDataValue.FromGeneric(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.Create(calleeValue, argValues)); + Result := TDataValue.FromGeneric(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; 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>; + 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.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; + 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; diff --git a/Src/AST/Myc.Ast.Script.pas b/Src/AST/Myc.Ast.Script.pas index 3b8ab73..6ed0dec 100644 --- a/Src/AST/Myc.Ast.Script.pas +++ b/Src/AST/Myc.Ast.Script.pas @@ -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. diff --git a/Src/AST/Myc.Ast.Types.pas b/Src/AST/Myc.Ast.Types.pas index bf170da..68e2e93 100644 --- a/Src/AST/Myc.Ast.Types.pas +++ b/Src/AST/Myc.Ast.Types.pas @@ -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; + TGenericRecordRegistry = TKeywordMappingRegistry; + // 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; 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', diff --git a/Src/Data/Myc.Data.Keyword.pas b/Src/Data/Myc.Data.Keyword.pas index 176c480..9482360 100644 --- a/Src/Data/Myc.Data.Keyword.pas +++ b/Src/Data/Myc.Data.Keyword.pas @@ -34,7 +34,7 @@ type class var FLock: TSpinLock; class var - FRegistry: TDictionary; + FRegistry: TDictionary; class var FReverseMap: TList; // Use TList class constructor Create; @@ -116,7 +116,7 @@ end; class constructor TKeywordRegistry.Create; begin FLock := TSpinLock.Create(false); - FRegistry := TDictionary.Create; + FRegistry := TDictionary.Create; FReverseMap := TList.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; diff --git a/Src/Data/Myc.Data.Scalar.pas b/Src/Data/Myc.Data.Scalar.pas index 13fe710..918ac30 100644 --- a/Src/Data/Myc.Data.Scalar.pas +++ b/Src/Data/Myc.Data.Scalar.pas @@ -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; diff --git a/Src/Data/Myc.Data.Value.pas b/Src/Data/Myc.Data.Value.pas index c6da2e2..9e11ba8 100644 --- a/Src/Data/Myc.Data.Value.pas +++ b/Src/Data/Myc.Data.Value.pas @@ -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; 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; inline; function AsSeries: ISeries; inline; function AsObject: TObject; overload; inline; @@ -179,6 +194,14 @@ begin Result := (FInterface as TVal).Value; end; +// Added +function TDataValue.AsGenericRecord: IKeywordMapping; +begin + if (FKind <> vkGenericRecord) then + raise EInvalidCast.Create('Cannot read value as GenericRecord.'); + Result := IKeywordMapping(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.Create(AValue); end; +// Added +class function TDataValue.FromGenericRecord(const AValue: IKeywordMapping): 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; // 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('', [sb.ToString]); + finally + sb.Free; + end; + end; vkVoid: Result := ''; vkMethod: Result := ''; 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;