Skip to content

Commit

Permalink
Basic generic map/stringmap/heap functionality
Browse files Browse the repository at this point in the history
  • Loading branch information
ollydev committed Aug 30, 2024
1 parent 5596afc commit 02c19b7
Show file tree
Hide file tree
Showing 20 changed files with 1,832 additions and 939 deletions.
26 changes: 11 additions & 15 deletions Source/ide/codetools/simba.ide_codetools_exprparser.pas
Original file line number Diff line number Diff line change
Expand Up @@ -121,7 +121,7 @@ function ParseExpression(Codeinsight: TCodeinsight; Expr: String; out Members: T

function Resolve(decls: TDeclarationArray; var Item: TExpressionItem): TDeclaration;
var
I, J: Integer;
I: Integer;
begin
Result := nil;

Expand All @@ -138,7 +138,7 @@ function ParseExpression(Codeinsight: TCodeinsight; Expr: String; out Members: T
if TDeclaration_Method(Decls[i]).ResultType <> nil then
begin
// indexable property.. clear symbol.
if (Decls[i] is TDeclaration_Property) and (TDeclaration_Property(Decls[i]).ParamCount > 1) then
if (Decls[i] is TDeclaration_Property) and (TDeclaration_Property(Decls[i]).ParamCount > 0) then
begin
Item.Symbols.DimCount := 0;
Item.HasSymbols := Item.Symbols.Deref or Item.Symbols.DerefDim;
Expand Down Expand Up @@ -253,21 +253,17 @@ function ParseExpression(Codeinsight: TCodeinsight; Expr: String; out Members: T

// last item is special
Last := Items[High(Items)];
for I := 0 to High(Members) do
if Members[I].IsName(Last.Text) then
begin
if (Members[I] is TDeclaration_Property) and (TDeclaration_Property(Members[I]).ParamCount > 1) then
if Last.HasSymbols then
Result := ResolveSymbols(Resolve(Members, Last), Last)
else
begin
for I := 0 to High(Members) do
if Members[I].IsName(Last.Text) then
begin
Last.Symbols.DimCount := 0;
Last.HasSymbols := Last.Symbols.Deref or Last.Symbols.DerefDim;
Result := Members[I];
Break;
end;

Result := Members[I];
Break;
end;

if (Result <> nil) and Last.HasSymbols then
Result := ResolveSymbols(Result, Last);
end;
end;

end.
Expand Down
176 changes: 176 additions & 0 deletions Source/ide/codetools/simba.ide_codetools_generics.pas
Original file line number Diff line number Diff line change
@@ -0,0 +1,176 @@
{
Author: Raymond van Venetië and Merlijn Wajer
Project: Simba (https://github.com/MerlijnWajer/Simba)
License: GNU General Public License (https://www.gnu.org/licenses/gpl-3.0)
}
unit simba.ide_codetools_generics;

{$i simba.inc}

interface

uses
Classes, SysUtils,
simba.base, simba.ide_codetools_parser;

const
MAP_METHODS =
'function <MapName>.Exists(Key: <KeyType>): Boolean; external;' + LineEnding +
'property <MapName>.Value(Key: <KeyType>): <ValueType>; external;' + LineEnding +
'property <MapName>.Value(Key: <KeyType>; Value: <ValueType>); external;' + LineEnding +
'property <MapName>.Count: Integer; external;' + LineEnding +
'procedure <MapName>.Clear; external;' + LineEnding +
'function <MapName>.IndexOf(Key: <KeyType>): Integer; external;' + LineEnding +
'procedure <MapName>.Delete(Key: <KeyType>); external;' + LineEnding +
'procedure <MapName>.DeleteIndex(Index: Integer); external;' + LineEnding +
'function <MapName>.ToString: String; external;' + LineEnding +
'property <MapName>.ValueFromIndex(Index: Integer): <ValueType>; external;' + LineEnding +
'property <MapName>.ValueFromIndex(Index: Integer; Value: <ValueType>); external;' + LineEnding +
'property <MapName>.KeyFromIndex(Index: Integer): <KeyType>; external;' + LineEnding +
'property <MapName>.KeyFromIndex(Index: Integer; Key: <KeyType>); external;' + LineEnding +
'property <MapName>.Values: array of <ValueType>; external;' + LineEnding +
'property <MapName>.Keys: array of <KeyType>; external;' + LineEnding +
'property <MapName>.InvalidVal: <ValueType>; external;' + LineEnding +
'property <MapName>.InvalidVal(Value: <ValueType>); external;' + LineEnding;

STRINGMAP_METHODS = MAP_METHODS +
'procedure <MapName>.Load(FileName: String; Sep: String; StrToValue: function(Str: String): <ValueType>); external;' + LineEnding +
'procedure <MapName>.Save(FileName: String; Sep: String; ValueToStr: function(Value: <ValueType>): String); external;' + LineEnding +
'property <MapName>.CaseSens: Boolean; external;' + LineEnding +
'property <MapName>.CaseSens(Value: Boolean); external;' + LineEnding;

HEAP_METHODS =
'procedure <HeapName>.Push(Value: <ValueType>; Index: Integer); external;' + LineEnding +
'property <HeapName>.Pop: record Value: <ValueType>; Index: Integer; end; external;' + LineEnding +
'property <HeapName>.Peek: record Value: <ValueType>; Index: Integer; end; external;' + LineEnding +
'property <HeapName>.Items: array of record Value: <ValueType>; Index: Integer; end; external;' + LineEnding +
'property <HeapName>.Count: Integer; external;' + LineEnding +
'procedure <HeapName>.Clear; external;' + LineEnding +
'function <HeapName>.ToString: String; external;' + LineEnding;

function GetGeneric(Decl: TDeclaration): TDeclarationArray;

implementation

var
GenericParsers: TCodeParserList;

function GetGeneric(Decl: TDeclaration): TDeclarationArray;

function RunStrMap(Name, Key, Value: String): TCodeParser;
var
I: Integer;
Methods, FileName: String;
begin
FileName := '!GenericStringMap::' + Name + '::' + Value;
for I := 0 to GenericParsers.Count - 1 do
if (GenericParsers[I].Lexer.FileName = FileName) then
Exit(GenericParsers[I]);

Methods := STRINGMAP_METHODS;
Methods := Methods.Replace('<MapName>', Name);
Methods := Methods.Replace('<KeyType>', Key);
Methods := Methods.Replace('<ValueType>', Value);

Result := TCodeParser.Create();
Result.SetScript(Methods);
Result.Run();

GenericParsers.Add(Result);
end;

function RunMap(Name, Key, Value: String): TCodeParser;
var
I: Integer;
Methods, FileName: String;
begin
FileName := '!GenericMap::' + Name + '::' + Key + ', ' + Value;
for I := 0 to GenericParsers.Count - 1 do
if (GenericParsers[I].Lexer.FileName = FileName) then
Exit(GenericParsers[I]);

Methods := MAP_METHODS;
Methods := Methods.Replace('<MapName>', Name);
Methods := Methods.Replace('<KeyType>', Key);
Methods := Methods.Replace('<ValueType>', Value);

Result := TCodeParser.Create();
Result.SetScript(Methods);
Result.Run();

GenericParsers.Add(Result);
end;

function RunHeap(Name, Value: String): TCodeParser;
var
I: Integer;
Methods, FileName: String;
begin
FileName := '!GenericHeap::' + Name + '::' + Value;
for I := 0 to GenericParsers.Count - 1 do
if (GenericParsers[I].Lexer.FileName = FileName) then
Exit(GenericParsers[I]);

Methods := HEAP_METHODS;
Methods := Methods.Replace('<HeapName>', Name);
Methods := Methods.Replace('<ValueType>', Value);

Result := TCodeParser.Create();
Result.SetScript(Methods);
Result.Run();

GenericParsers.Add(Result);
end;

var
Parser: TCodeParser;
Params: TDeclarationArray;
Name, Kind: String;
begin
Parser := nil;

if (Decl is TDeclaration_TypeFakeGeneric) then
begin
Kind := Decl.Items.GetTextOfClass(TDeclaration_Identifier);
Name := Decl.Name;
if (Name = '') then
Name := Kind;

case LowerCase(Kind) of
'stringmap':
begin
Params := Decl.Items.GetByClass(TDeclaration_Parameter, True, True);
if Length(Params) = 1 then
Parser := RunStrMap(Name, 'String', Params[0].Name);
end;

'map':
begin
Params := Decl.Items.GetByClass(TDeclaration_Parameter, True, True);
if Length(Params) = 2 then
Parser := RunMap(Name, Params[0].Name, Params[1].Name);
end;

'heap':
begin
Params := Decl.Items.GetByClass(TDeclaration_Parameter, True, True);
if Length(Params) = 1 then
Parser := RunHeap(Name, Params[0].Name);
end;
end;
end;

if (Parser <> nil) then
Result := Parser.Items.ToArray
else
Result := [];
end;

initialization
GenericParsers := TCodeParserList.Create(True);

finalization
FreeAndNil(GenericParsers);

end.

5 changes: 3 additions & 2 deletions Source/ide/codetools/simba.ide_codetools_insight.pas
Original file line number Diff line number Diff line change
Expand Up @@ -89,7 +89,8 @@ implementation
simba.settings,
simba.ide_codetools_includes,
simba.ide_codetools_exprparser,
simba.ide_codetools_arrayhelpers;
simba.ide_codetools_arrayhelpers,
simba.ide_codetools_generics;

function TCodeinsight.GetIncludesHash: String;
begin
Expand Down Expand Up @@ -387,7 +388,7 @@ function TCodeinsight.GetTypeMembers(Decl: TDeclaration_Type; Methods: Boolean):
Depth, I: Integer;
Decls: TDeclarationArray;
begin
Result := GetArrayHelpers(Decl); // start with (possible) array helpers
Result := GetArrayHelpers(Decl) + GetGeneric(Decl); // start with (possible) array helpers

Depth := 0;
while (Decl <> nil) and (Depth < 20) do // max depth of 20 for safety
Expand Down
52 changes: 41 additions & 11 deletions Source/ide/codetools/simba.ide_codetools_parser.pas
Original file line number Diff line number Diff line change
Expand Up @@ -113,6 +113,7 @@ TDeclaration = class({$IFDEF PARSER_LEAK_CHECKS}TLeakChecker{$ELSE}TObject{$EN
public
procedure Add(const Decl: TDeclaration); overload;
procedure Add(const Decls: TDeclarationArray); overload;
procedure Remove(const Decl: TDeclaration);

function GetByName(Name: String): TDeclarationArray;
function GetByClassAndName(Name: String; DeclClass: TDeclarationClass; ExactClass: Boolean = False): TDeclarationArray;
Expand Down Expand Up @@ -245,6 +246,7 @@ TDeclaration_TypeMethod = class(TDeclaration_Type)
property Method: TDeclaration_Method read GetMethod;
end;

TDeclaration_TypeFakeGeneric = class(TDeclaration_Type);
TDeclaration_TypeNativeMethod = class(TDeclaration_Type);

TDeclaration_TypeRange = class(TDeclaration_Type);
Expand Down Expand Up @@ -455,7 +457,6 @@ TCodeParser = class(TPasParser)
procedure MethodDirective; override;
procedure Method; override;
procedure MethodOfType; override;
procedure MethodBlock; override;
procedure MethodName; override;
procedure MethodTypeName; override;
procedure MethodResultType; override;
Expand Down Expand Up @@ -490,6 +491,8 @@ TCodeParser = class(TPasParser)
// types - native
procedure NativeType; override;

procedure FakeGenericType; override;

// types = record
procedure UnionType; override;
procedure RecordType; override;
Expand Down Expand Up @@ -908,6 +911,18 @@ procedure TDeclarationArrayHelper.Add(const Decls: TDeclarationArray);
Self += Decls;
end;

procedure TDeclarationArrayHelper.Remove(const Decl: TDeclaration);
var
I: Integer;
begin
for I := 0 to High(Self) do
if (Self[I] = Decl) then
begin
Delete(Self, I, 1);
Exit;
end;
end;

function TDeclarationArrayHelper.GetByName(Name: String): TDeclarationArray;
var
I, Count: Integer;
Expand Down Expand Up @@ -1801,15 +1816,6 @@ procedure TCodeParser.ConstantName;
VarName();
end;

procedure TCodeParser.MethodBlock;
begin
//if (FStack.Top is TDeclaration_Method) then
// if (fLastNoJunkTok <> tokSemiColon) then
// TDeclaration_Method(FStack.Top).isNotFullyDeclared := True;

inherited;
end;

procedure TCodeParser.Method;
var
Decl: TDeclaration_Method;
Expand Down Expand Up @@ -1932,6 +1938,13 @@ procedure TCodeParser.NativeType;
PopStack();
end;

procedure TCodeParser.FakeGenericType;
begin
PushStack(TDeclaration_TypeFakeGeneric);
inherited;
PopStack();
end;

procedure TCodeParser.RecordType;
begin
PushStack(TDeclaration_TypeRecord);
Expand Down Expand Up @@ -2272,11 +2285,28 @@ function RemoveDuplicateProperties(Decls: TDeclarationArray): TDeclarationArray;
SetLength(Result, Length(Decls));
for I := 0 to High(Decls) do
begin
if (Decls[I] is TDeclaration_Property) and HasProperty(TDeclaration_Property(Decls[I]), Result, Count) then
if (Decls[I] is TDeclaration_Property) then
Continue;
Result[Count] := Decls[I];
Inc(Count);
end;

// add write first, they're more useful
for I := 0 to High(Decls) do
if (Decls[I] is TDeclaration_Property) and TDeclaration_Property(Decls[I]).IsWrite then
begin
Result[Count] := Decls[I];
Inc(Count);
end;
// add read if write does not exist
for I := 0 to High(Decls) do
if (Decls[I] is TDeclaration_Property) and TDeclaration_Property(Decls[I]).IsRead and
(not HasProperty(Decls[I] as TDeclaration_Property, Result, Count)) then
begin
Result[Count] := Decls[I];
Inc(Count);
end;

SetLength(Result, Count);
end;

Expand Down
Loading

0 comments on commit 02c19b7

Please sign in to comment.