Assign tuple optimizer (#3160)

* branch init

* add BindCollectLightSymInfo

* moved lightsyminfo to syntaxVisitors

* LIghtSymInfo fixes

* binder 0.1

* Attributes -> SymbolAttributes

* AssignTupleOptimizer -> AssignTupleDesugar

* moved algorithm classes to AssignTupleDesugarAlgorithm namespace

* fixes and refactoring

* LightSymInfo rework

* add rebuildDebug and build units

* enable VarNamesInMethodsWithSameNameAsClassGenericParamsReplacer

* remove CollectFullLightSymInfo call

* bind now return BindResult

* change BindResult path type

* path testing

* fix Current in BindCollectLightSymInfo

* fix Current in BindCollectLightSymInfo

* fix #3116

* (the rest of the fix)

* potential symomyms handling without assigns count minimization

* assign count minimization

* rename AssignTuplesDesugar

* move NewAssignTupleDesugar

* add optimization switch

* delete AssignTupleDesugar project

* remove comments

* collect symbols from var tuples

* optimize var_tuple_def_statement and assign_var_tuple

* fix

* fix Tuple Visitor

* #3091

* #3125

* revert #3125

* #3125

* #3123

* #3123

* #3127

* fix

* del doc

* await переместил

* Перегенерировал грамматику

* s.ToLines
RenameDirectory

* Исправление ToLines

* Убрал из грамматики узлы await - случайно оставались

* Sync `.ToLines` with `System.IO.StringReader` (#3154)

* 3.9.0.3494

* add const optimization

* #3152

* #3152

---------

Co-authored-by: Sun Serega <sunserega2@gmail.com>
Co-authored-by: Ivan Bondarev <ibond84@googlemail.com>
Co-authored-by: Mikhalkovich Stanislav <miks@math.sfedu.ru>
Co-authored-by: Артём Филонов <afilono@sfedu.ru>
This commit is contained in:
nevermind322 2024-06-24 19:54:40 +03:00 committed by GitHub
parent 66eaa619a3
commit 75e79d9a82
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
23 changed files with 2549 additions and 2373 deletions

View file

@ -2709,16 +2709,19 @@ namespace PascalABCCompiler
if (!PCUFileNamesDictionary.TryGetValue(cacheKey, out var fileNameWithPriority))
{
if (FindFileWithExtensionInDirs(fileName, out _, currentPath) is string resultFileName1)
if (Path.GetExtension(fileName) != CompilerOptions.CompiledUnitExtension)
fileNameWithPriority = null;
else if (FindFileWithExtensionInDirs(fileName, out _, currentPath) is string resultFileName1)
fileNameWithPriority = Tuple.Create(resultFileName1, 1);
else if (FindFileWithExtensionInDirs(Path.GetFileName(fileName), out _, CompilerOptions.OutputDirectory) is string resultFileName2)
else if (CompilerOptions.OutputDirectory != CompilerOptions.SourceFileDirectory && FindFileWithExtensionInDirs(Path.GetFileName(fileName), out _, CompilerOptions.OutputDirectory) is string resultFileName2)
fileNameWithPriority = Tuple.Create(resultFileName2, 2);
else if (FindFileWithExtensionInDirs(fileName, out var dirIndex, CompilerOptions.SearchDirectories.ToArray()) is string resultFileName3)
fileNameWithPriority = Tuple.Create(resultFileName3, 3 + dirIndex);
else
fileNameWithPriority = null;
PCUFileNamesDictionary[cacheKey] = fileNameWithPriority;
PCUFileNamesDictionary[cacheKey] = fileNameWithPriority;
}
folderPriority = fileNameWithPriority?.Item2 ?? 0;
@ -2730,8 +2733,9 @@ namespace PascalABCCompiler
var cacheKey = Tuple.Create(fileName.ToLower(), currentPath?.ToLower());
if (!SourceFileNamesDictionary.TryGetValue(cacheKey, out var fileNameWithPriority))
{
if (FindSourceFileNameInDirs(fileName, out _, currentPath) is string resultFileName1)
{
if (FindSourceFileNameInDirs(fileName, out _, currentPath) is string resultFileName1)
fileNameWithPriority = Tuple.Create(resultFileName1, 1);
else if (FindSourceFileNameInDirs(fileName, out var dirIndex, CompilerOptions.SearchDirectories.ToArray()) is string resultFileName2)
fileNameWithPriority = Tuple.Create(resultFileName2, 3 + dirIndex);
@ -3362,8 +3366,18 @@ namespace PascalABCCompiler
// It's not always possible to solve by re-ordering the references, since there are cases of
// mutually-dependent assemblies (i.e. dependency loops) in the wild.
foreach (var reference in referenceDirectives)
PreloadReference(reference);
{
try
{
PreloadReference(reference);
}
catch (FileLoadException ex)
{
throw new CommonCompilerError(ex.Message, compilationUnit.SyntaxTree.file_name, reference.location.begin_line_num, reference.location.end_line_num);
}
}
foreach (var reference in referenceDirectives)
CompileReference(dlls, reference);

View file

@ -1847,7 +1847,10 @@ namespace PascalABCCompiler.PCU
common_method_node raise_meth = null;
if (CanReadObject())
raise_meth = GetClassMethod(br.ReadInt32());
class_field cf = GetClassField(br.ReadInt32());
int field_off = br.ReadInt32();
class_field cf = null;
if (field_off > 0)
cf = GetClassField(field_off);
common_type_node cont = (common_type_node)GetTypeReference(br.ReadInt32());
if (name==null)
name = GetStringInClass(cont, name_ref);

View file

@ -3021,7 +3021,10 @@ namespace PascalABCCompiler.PCU
bw.Write(GetMemberOffset(_event.remove_method));
if (CanWriteObject(_event.raise_method))
bw.Write(GetMemberOffset(_event.raise_method));
bw.Write(GetMemberOffset(_event.field));
if (!_event.cont_type.IsInterface)
bw.Write(GetMemberOffset(_event.field));
else
bw.Write(0);
bw.Write(offset);
bw.Write((byte)_event.field_access_level);
bw.Write((byte)_event.polymorphic_state);

View file

@ -15,7 +15,7 @@ internal static class RevisionClass
public const string Major = "3";
public const string Minor = "9";
public const string Build = "0";
public const string Revision = "3489";
public const string Revision = "3494";
public const string MainVersion = Major + "." + Minor;
public const string FullVersion = Major + "." + Minor + "." + Build + "." + Revision;

View file

@ -1,4 +1,4 @@
%MINOR%=9
%REVISION%=3489
%COREVERSION%=0
%REVISION%=3494
%MINOR%=9
%MAJOR%=3

View file

@ -1,9 +1,9 @@
//
// This CSharp output file generated by Gardens Point LEX
// Version: 1.1.3.301
// Machine: DESKTOP-V3E9T2U
// DateTime: 25.05.2024 22:13:44
// UserName: alex
// Machine: DESKTOP-G8V08V4
// DateTime: 17.06.2024 16:43:45
// UserName: ?????????
// GPLEX input file <ABCPascal.lex>
// GPLEX frame file <embedded resource>
//

View file

@ -3373,8 +3373,6 @@ expr_l1_for_lambda
expr_dq
: relop_expr
{ $$ = $1; }
| tkAwait relop_expr
{ $$ = $2; }
| expr_dq tkDoubleQuestion relop_expr
{ $$ = new double_question_node($1 as expression, $3 as expression, @$);}
;

File diff suppressed because it is too large Load diff

View file

@ -377,6 +377,9 @@ script=

Binary file not shown.

View file

@ -4707,9 +4707,12 @@ namespace PascalABCCompiler.NETGenerator
{
ICommonTypeNode ctn = init_value.type as ICommonTypeNode;
IExpressionNode[] FieldValues = init_value.FieldValues;
ICommonClassFieldNode[] Fields = ctn.fields;
List<ICommonClassFieldNode> Fields = new List<ICommonClassFieldNode>();
foreach (var field in ctn.fields)
if (field.polymorphic_state != polymorphic_state.ps_static)
Fields.Add(field);
for (int i = 0; i < Fields.Length; i++)
for (int i = 0; i < Fields.Count; i++)
{
FldInfo field = helper.GetField(Fields[i]);
if (FieldValues[i] is IArrayInitializer)
@ -4750,9 +4753,12 @@ namespace PascalABCCompiler.NETGenerator
{
ICommonTypeNode ctn = init_value.type as ICommonTypeNode;
IConstantNode[] FieldValues = init_value.FieldValues;
ICommonClassFieldNode[] Fields = ctn.fields;
List<ICommonClassFieldNode> Fields = new List<ICommonClassFieldNode>();
foreach (var field in ctn.fields)
if (field.polymorphic_state != polymorphic_state.ps_static)
Fields.Add(field);
for (int i = 0; i < Fields.Length; i++)
for (int i = 0; i < Fields.Count; i++)
{
FldInfo field = helper.GetField(Fields[i]);
if (FieldValues[i] is IArrayConstantNode)

View file

@ -1 +1 @@
3.9.0.3489
3.9.0.3494

View file

@ -1 +1 @@
!define VERSION '3.9.0.3489'
!define VERSION '3.9.0.3494'

View file

@ -113,13 +113,16 @@ namespace SyntaxVisitors
return;
}
var newNameCache = new Dictionary<string, string>();
var newLocalNames = var_def.vars.idents.Select(id =>
{
var low = id.name.ToLower();
var newName = this.CreateNewVariableName(low);
//BlockNamesStack[CurrentLevel].Add(low, newName);
BlockNamesStack[CurrentLevel][low] = newName;
//BlockNamesStack[CurrentLevel][low] = newName;
newNameCache[low] = newName;
return new ident(newName, id.source_context);
});
@ -130,6 +133,8 @@ namespace SyntaxVisitors
Replace(var_def, newVS);
listNodes[listNodes.Count - 1] = newVS; //SSM 8.11.18
ProcessNode(newVS.inital_value); // SSM 10.06.2020 #2103
foreach (var key in newNameCache.Keys)
BlockNamesStack[CurrentLevel][key] = newNameCache[key];
//base.visit(newVS); // SSM 10.06.2020 - зачем обходить всё?
}

View file

@ -1430,24 +1430,26 @@ function ParamStr(i: integer): string;
/// Возвращает текущий каталог
function GetDir: string;
/// Меняет текущий каталог
procedure ChDir(s: string);
procedure ChDir(dirName: string);
/// Создает каталог
procedure MkDir(s: string);
procedure MkDir(dirName: string);
/// Удаляет каталог
procedure RmDir(s: string);
procedure RmDir(dirName: string);
/// Создает каталог. Возвращает True, если каталог успешно создан
function CreateDir(s: string): boolean;
function CreateDir(dirName: string): boolean;
/// Удаляет файл. Если файл не может быть удален, то возвращает False
function DeleteFile(fname: string): boolean;
function DeleteFile(fileName: string): boolean;
/// Возвращает текущий каталог
function GetCurrentDir: string;
/// Удаляет каталог. Возвращает True, если каталог успешно удален
function RemoveDir(s: string): boolean;
function RemoveDir(dirName: string): boolean;
/// Переименовывает файл fileName, давая ему новое имя newfileName. Возвращает True, если файл успешно переименован
function RenameFile(fileName, newfileName: string): boolean;
/// Переименовывает каталог dirName, давая ему новое имя newDirName. Возвращает True, если каталог успешно переименован
function RenameDirectory(dirName, newDirName: string): boolean;
/// Устанавливает текущий каталог. Возвращает True, если каталог успешно удален
function SetCurrentDir(s: string): boolean;
function SetCurrentDir(dirName: string): boolean;
/// Изменяет расширение файла с именем fileName на newExt
function ChangeFileNameExtension(fileName, newExt: string): string;
@ -1462,9 +1464,9 @@ procedure Assert(cond: boolean; sourceFile: string := ''; line: integer := 0);
procedure Assert(cond: boolean; message: string; sourceFile: string := ''; line: integer := 0);
/// Возвращает свободное место в байтах на диске с именем diskname
function DiskFree(diskname: string): int64;
function DiskFree(diskName: string): int64;
/// Возвращает размер в байтах на диске с именем diskname
function DiskSize(diskname: string): int64;
function DiskSize(diskName: string): int64;
/// Возвращает свободное место в байтах на диске disk. disk=0 - текущий диск, disk=1 - диск A: , disk=2 - диск B: и т.д.
function DiskFree(disk: integer): int64;
/// Возвращает размер в байтах на диске disk. disk=0 - текущий диск, disk=1 - диск A: , disk=2 - диск B: и т.д.
@ -8459,41 +8461,41 @@ begin
Result := Environment.CurrentDirectory;
end;
procedure ChDir(s: string);
procedure ChDir(dirName: string);
begin
Environment.CurrentDirectory := s;
Environment.CurrentDirectory := dirName;
end;
procedure MkDir(s: string);
procedure MkDir(dirName: string);
begin
Directory.CreateDirectory(s);
Directory.CreateDirectory(dirName);
end;
procedure RmDir(s: string);
procedure RmDir(dirName: string);
begin
Directory.Delete(s);
Directory.Delete(dirName);
end;
function CreateDir(s: string): boolean;
function CreateDir(dirName: string): boolean;
begin
try
Result := True;
Directory.CreateDirectory(s);
Directory.CreateDirectory(dirName);
except
Result := False;
end;
end;
function DeleteFile(fname: string): boolean;
function DeleteFile(fileName: string): boolean;
begin
if not &File.Exists(fname) then
if not &File.Exists(fileName) then
begin
Result := False;
exit
end;
try
Result := True;
&File.Delete(fname);
&File.Delete(fileName);
except
Result := False;
end;
@ -8504,11 +8506,11 @@ begin
Result := Environment.CurrentDirectory;
end;
function RemoveDir(s: string): boolean;
function RemoveDir(dirName: string): boolean;
begin
try
Result := True;
Directory.Delete(s);
Directory.Delete(dirName);
except
Result := False;
end;
@ -8524,11 +8526,21 @@ begin
end;
end;
function SetCurrentDir(s: string): boolean;
function RenameDirectory(dirName, newDirName: string): boolean;
begin
try
Result := True;
Environment.CurrentDirectory := s;
Directory.Move(dirName, newDirName);
except
Result := False;
end;
end;
function SetCurrentDir(dirName: string): boolean;
begin
try
Result := True;
Environment.CurrentDirectory := dirName;
except
Result := False;
end;
@ -8596,7 +8608,7 @@ begin
System.Diagnostics.Contracts.Contract.Assert(cond,'Файл '+sourceFile+', строка '+line.ToString() + ': ' + message)
end;
function DiskFree(diskname: string): int64;
function DiskFree(diskName: string): int64;
begin
try
var d := new System.IO.DriveInfo(diskname);
@ -8606,7 +8618,7 @@ begin
end;
end;
function DiskSize(diskname: string): int64;
function DiskSize(diskName: string): int64;
begin
try
var d := new System.IO.DriveInfo(diskname);
@ -13743,6 +13755,23 @@ begin
Result := Self.Split(delims.ToCharArray, System.StringSplitOptions.RemoveEmptyEntries);
end;
/// Преобразует многострочную строку в массив строк
function ToLines(Self: string): array of string; extensionmethod;
begin
Result := Self.Split(|
#13#10, // CR+LF: Win
#10, // LF: Linux
#13 // CR: Mac
// https://en.m.wikipedia.org/wiki/Newline#Unicode
// But standard .Net things like System.IO.StringReader don't support these, so for now - commented out
// #11, // Vertical Tab
// #12, // Form feed
// char($85), // Next Line
// char($2028), // Line Separator
// char($2029), // Paragraph SeparatorS
|, System.StringSplitOptions.None);
end;
procedure PassSpaces(var s: string; var from: integer);
begin
while (from <= s.Length) and char.IsWhiteSpace(s[from]) do

View file

@ -0,0 +1,8 @@
//!Повторно объявленный идентификатор name
type
name = (name);
begin
// Ожидался тип
var v1: name;
end.

View file

@ -0,0 +1,11 @@
//!Количество полей не совпадает с количеством полей в записи
type
r1 = record
a: byte;
static b: word;
end;
begin
// Работает, но не должно
var a: r1 := (a: 1; b: 2);
end.

11
TestSuite/recinit3.pas Normal file
View file

@ -0,0 +1,11 @@
type
r1 = record
a: byte;
static b: word;
end;
begin
//Ошибка: Количество полей не совпадает с количеством полей в записи
var a: r1 := (a: 1);
assert(a.a = 1);
end.

View file

@ -0,0 +1,10 @@
unit u_events6;
uses System;
type
I1 = interface
event E1: Action;
end;
end.

View file

@ -0,0 +1,20 @@
uses u_events6, System;
type TClass = class(I1)
event E1: Action;
procedure RaiseMethod;
begin
if E1 <> nil then
E1();
end;
end;
begin
var i := 0;
var o := new TClass;
o.E1 += () -> begin Inc(i) end;
o.RaiseMethod();
assert(i = 1);
end.

29
TestSuite/yield8.pas Normal file
View file

@ -0,0 +1,29 @@
function V(n: byte) := 1;
function f1: sequence of integer;
begin
//Ошибка: Ожидалось имя процедуры или функции
var v := V(0);
// Если закомментировать эту строчку - предыдущая строчка работает
yield v;
end;
function f2: sequence of integer;
begin
//Ошибка: Ожидалось имя процедуры или функции
var v := V(0);
var w := v + 1;
// Если закомментировать эту строчку - предыдущая строчка работает
yield w;
end;
begin
var i := 0;
foreach var j in f1 do
i := j;
assert(i = 1);
foreach var j in f2 do
i := j;
assert(i = 2);
end.

View file

@ -12211,6 +12211,8 @@ namespace PascalABCCompiler.TreeConverter
context.check_name_free(name, loc);
is_direct_type_decl = true;
type_node tn = convert_strong(_type_declaration.type_def);
if (_type_declaration.type_def is enum_type_definition)
context.check_name_free(name, loc);
assign_doc_info(tn,_type_declaration);
is_direct_type_decl = false;
if (_type_declaration.type_def is SyntaxTree.named_type_reference||
@ -15595,13 +15597,14 @@ namespace PascalABCCompiler.TreeConverter
private record_initializer ConvertRecordInitializer(common_type_node ctn, record_initializer constant)
{
location loc = constant.location;
var non_static_fields = ctn.fields.Where(x => !x.IsStatic).ToArray();
if (!ctn.is_value_type)
AddError(loc, "RECORD_CONST_NOT_ALLOWED_{0}", ctn.name);
if (ctn.fields.Count != constant.record_const_definition_list.Count)
if (non_static_fields.Length != constant.record_const_definition_list.Count)
AddError(loc, "INVALID_RECORD_CONST_FIELD_COUNT");
constant.type = ctn;
constant.field_values.Clear();
for (int i = 0; i < ctn.fields.Count; i++)
for (int i = 0; i < non_static_fields.Length; i++)
{
class_field cf = ctn.fields[i];
if (cf.name.ToLower() != constant.record_const_definition_list[i].name.name.ToLower())

View file

@ -1430,24 +1430,26 @@ function ParamStr(i: integer): string;
/// Возвращает текущий каталог
function GetDir: string;
/// Меняет текущий каталог
procedure ChDir(s: string);
procedure ChDir(dirName: string);
/// Создает каталог
procedure MkDir(s: string);
procedure MkDir(dirName: string);
/// Удаляет каталог
procedure RmDir(s: string);
procedure RmDir(dirName: string);
/// Создает каталог. Возвращает True, если каталог успешно создан
function CreateDir(s: string): boolean;
function CreateDir(dirName: string): boolean;
/// Удаляет файл. Если файл не может быть удален, то возвращает False
function DeleteFile(fname: string): boolean;
function DeleteFile(fileName: string): boolean;
/// Возвращает текущий каталог
function GetCurrentDir: string;
/// Удаляет каталог. Возвращает True, если каталог успешно удален
function RemoveDir(s: string): boolean;
function RemoveDir(dirName: string): boolean;
/// Переименовывает файл fileName, давая ему новое имя newfileName. Возвращает True, если файл успешно переименован
function RenameFile(fileName, newfileName: string): boolean;
/// Переименовывает каталог dirName, давая ему новое имя newDirName. Возвращает True, если каталог успешно переименован
function RenameDirectory(dirName, newDirName: string): boolean;
/// Устанавливает текущий каталог. Возвращает True, если каталог успешно удален
function SetCurrentDir(s: string): boolean;
function SetCurrentDir(dirName: string): boolean;
/// Изменяет расширение файла с именем fileName на newExt
function ChangeFileNameExtension(fileName, newExt: string): string;
@ -1462,9 +1464,9 @@ procedure Assert(cond: boolean; sourceFile: string := ''; line: integer := 0);
procedure Assert(cond: boolean; message: string; sourceFile: string := ''; line: integer := 0);
/// Возвращает свободное место в байтах на диске с именем diskname
function DiskFree(diskname: string): int64;
function DiskFree(diskName: string): int64;
/// Возвращает размер в байтах на диске с именем diskname
function DiskSize(diskname: string): int64;
function DiskSize(diskName: string): int64;
/// Возвращает свободное место в байтах на диске disk. disk=0 - текущий диск, disk=1 - диск A: , disk=2 - диск B: и т.д.
function DiskFree(disk: integer): int64;
/// Возвращает размер в байтах на диске disk. disk=0 - текущий диск, disk=1 - диск A: , disk=2 - диск B: и т.д.
@ -8459,41 +8461,41 @@ begin
Result := Environment.CurrentDirectory;
end;
procedure ChDir(s: string);
procedure ChDir(dirName: string);
begin
Environment.CurrentDirectory := s;
Environment.CurrentDirectory := dirName;
end;
procedure MkDir(s: string);
procedure MkDir(dirName: string);
begin
Directory.CreateDirectory(s);
Directory.CreateDirectory(dirName);
end;
procedure RmDir(s: string);
procedure RmDir(dirName: string);
begin
Directory.Delete(s);
Directory.Delete(dirName);
end;
function CreateDir(s: string): boolean;
function CreateDir(dirName: string): boolean;
begin
try
Result := True;
Directory.CreateDirectory(s);
Directory.CreateDirectory(dirName);
except
Result := False;
end;
end;
function DeleteFile(fname: string): boolean;
function DeleteFile(fileName: string): boolean;
begin
if not &File.Exists(fname) then
if not &File.Exists(fileName) then
begin
Result := False;
exit
end;
try
Result := True;
&File.Delete(fname);
&File.Delete(fileName);
except
Result := False;
end;
@ -8504,11 +8506,11 @@ begin
Result := Environment.CurrentDirectory;
end;
function RemoveDir(s: string): boolean;
function RemoveDir(dirName: string): boolean;
begin
try
Result := True;
Directory.Delete(s);
Directory.Delete(dirName);
except
Result := False;
end;
@ -8524,11 +8526,21 @@ begin
end;
end;
function SetCurrentDir(s: string): boolean;
function RenameDirectory(dirName, newDirName: string): boolean;
begin
try
Result := True;
Environment.CurrentDirectory := s;
Directory.Move(dirName, newDirName);
except
Result := False;
end;
end;
function SetCurrentDir(dirName: string): boolean;
begin
try
Result := True;
Environment.CurrentDirectory := dirName;
except
Result := False;
end;
@ -8596,7 +8608,7 @@ begin
System.Diagnostics.Contracts.Contract.Assert(cond,'Файл '+sourceFile+', строка '+line.ToString() + ': ' + message)
end;
function DiskFree(diskname: string): int64;
function DiskFree(diskName: string): int64;
begin
try
var d := new System.IO.DriveInfo(diskname);
@ -8606,7 +8618,7 @@ begin
end;
end;
function DiskSize(diskname: string): int64;
function DiskSize(diskName: string): int64;
begin
try
var d := new System.IO.DriveInfo(diskname);
@ -13743,6 +13755,23 @@ begin
Result := Self.Split(delims.ToCharArray, System.StringSplitOptions.RemoveEmptyEntries);
end;
/// Преобразует многострочную строку в массив строк
function ToLines(Self: string): array of string; extensionmethod;
begin
Result := Self.Split(|
#13#10, // CR+LF: Win
#10, // LF: Linux
#13 // CR: Mac
// https://en.m.wikipedia.org/wiki/Newline#Unicode
// But standard .Net things like System.IO.StringReader don't support these, so for now - commented out
// #11, // Vertical Tab
// #12, // Form feed
// char($85), // Next Line
// char($2028), // Line Separator
// char($2029), // Paragraph SeparatorS
|, System.StringSplitOptions.None);
end;
procedure PassSpaces(var s: string; var from: integer);
begin
while (from <= s.Length) and char.IsWhiteSpace(s[from]) do