diff --git a/Compiler/Compiler.cs b/Compiler/Compiler.cs index 3c2f2f276..c7c1d86eb 100644 --- a/Compiler/Compiler.cs +++ b/Compiler/Compiler.cs @@ -1133,7 +1133,8 @@ namespace PascalABCCompiler InternalDebug = new CompilerInternalDebug(); ParsersController.SourceFilesProvider = sourceFilesProvider; - + ParsersController.SendUnitCheckToParsers(CurrentUnitIsNotMainProgram); + SyntaxTreeToSemanticTreeConverter = new TreeConverter.SyntaxTreeToSemanticTreeConverter(); CodeGeneratorsController = new CodeGenerators.Controller(); @@ -4172,7 +4173,10 @@ namespace PascalABCCompiler } return SourceText; } - + private bool CurrentUnitIsNotMainProgram() + { + return currentCompilationUnit != null; + } private Dictionary GenUnitDocumentation(CompilationUnit currentUnit, string SourceText) { Dictionary docs = null; diff --git a/Configuration/GlobalAssemblyInfo.cs b/Configuration/GlobalAssemblyInfo.cs index e24dd3f30..47a223edb 100644 --- a/Configuration/GlobalAssemblyInfo.cs +++ b/Configuration/GlobalAssemblyInfo.cs @@ -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 = "3467"; + public const string Revision = "3468"; public const string MainVersion = Major + "." + Minor; public const string FullVersion = Major + "." + Minor + "." + Build + "." + Revision; diff --git a/Configuration/Version.defs b/Configuration/Version.defs index 72e9cb7bc..cd34db5ba 100644 --- a/Configuration/Version.defs +++ b/Configuration/Version.defs @@ -1,4 +1,4 @@ -%MINOR%=9 -%REVISION%=3467 %COREVERSION%=0 +%REVISION%=3468 +%MINOR%=9 %MAJOR%=3 diff --git a/Localization/DefaultLang.resources b/Localization/DefaultLang.resources index d2c271dce..5d0e35160 100644 Binary files a/Localization/DefaultLang.resources and b/Localization/DefaultLang.resources differ diff --git a/ParserTools/ParserTools/BaseParser.cs b/ParserTools/ParserTools/BaseParser.cs index 67863896b..4c56027ce 100644 --- a/ParserTools/ParserTools/BaseParser.cs +++ b/ParserTools/ParserTools/BaseParser.cs @@ -1,9 +1,9 @@ // Copyright (c) Ivan Bondarev, Stanislav Mikhalkovich (for details please see \doc\copyright.txt) // This code is distributed under the GNU LGPL (for details please see \doc\license.txt) using System.Collections.Generic; -using System.Text.RegularExpressions; using PascalABCCompiler.Errors; using PascalABCCompiler.SyntaxTree; +using System; namespace PascalABCCompiler.Parsers { @@ -112,6 +112,8 @@ namespace PascalABCCompiler.Parsers public string[] SystemUnitNames { get; } + public Func CheckIfParsingUnit { get; set; } + public Dictionary ValidDirectives { get; protected set; } public SourceFilesProviderDelegate sourceFilesProvider = null; diff --git a/ParserTools/ParsersController.cs b/ParserTools/ParsersController.cs index fbb912afb..1c080b6f3 100644 --- a/ParserTools/ParsersController.cs +++ b/ParserTools/ParsersController.cs @@ -123,6 +123,14 @@ namespace PascalABCCompiler.Parsers parser.SourceFilesProvider = SourceFilesProvider; ParserConnected?.Invoke(parser); } + public void SendUnitCheckToParsers(Func callback) + { + foreach (IParser parser in Parsers) + { + if (parser is BaseParser baseParser) + baseParser.CheckIfParsingUnit = callback; + } + } /// /// Возвращает подходящий для переданного расширения парсер из имеющихся diff --git a/Release/pabcversion.txt b/Release/pabcversion.txt index 63fb2005c..e140cc85b 100644 --- a/Release/pabcversion.txt +++ b/Release/pabcversion.txt @@ -1 +1 @@ -3.9.0.3467 +3.9.0.3468 diff --git a/ReleaseGenerators/PascalABCNET_version.nsh b/ReleaseGenerators/PascalABCNET_version.nsh index f4636dad1..935aa9e93 100644 --- a/ReleaseGenerators/PascalABCNET_version.nsh +++ b/ReleaseGenerators/PascalABCNET_version.nsh @@ -1 +1 @@ -!define VERSION '3.9.0.3467' +!define VERSION '3.9.0.3468' diff --git a/TestSuite/CompilationSamples/PABCSystem.pas b/TestSuite/CompilationSamples/PABCSystem.pas index 34ed51fd4..86781eaeb 100644 --- a/TestSuite/CompilationSamples/PABCSystem.pas +++ b/TestSuite/CompilationSamples/PABCSystem.pas @@ -1506,17 +1506,18 @@ function EnumerateDirectories(path: string): sequence of string; /// Возвращает последовательность имен каталогов по заданному пути, включая подкаталоги function EnumerateAllDirectories(path: string): sequence of string; -/// Для типа System.Type возвращает имя типа объекта +/// Возвращает имя отражённого типа "t" function TypeToTypeName(t: System.Type): string; -/// Для типа System.Type записывает в res имя типа объекта +/// Добавляет в res имя отражённого типа "t" procedure TypeToTypeName(t: System.Type; res: StringBuilder); -/// Для типа System.Type записывает в res имя типа объекта +/// Записывает в res имя отражённого типа "t" procedure TypeToTypeName(t: System.Type; res: TextWriter); -/// Возвращает имя типа объекта + +/// Возвращает имя типа объекта "o" function TypeName(o: object): string; -/// Записывает в res имя типа объекта +/// Добавляет в res имя типа объекта "o" procedure TypeName(o: object; res: StringBuilder); -/// Записывает в res имя типа объекта +/// Записывает в res имя типа объекта "o" procedure TypeName(o: object; res: TextWriter); ///-procedure New(var p: ^T); @@ -2674,11 +2675,11 @@ function RuntimeInitialize(kind: byte; variable: object): object; ///Вычисление размера типа на этапе выполнения function GetRuntimeSize: integer; -/// Возвращает строку для вывода в write +/// Возвращает строку для вывода подобного Write function _ObjectToString(o: object): string; -/// Записывает в res строку для вывода в write +/// Добавляет в res строку для вывода подобного Write procedure _ObjectToString(o: object; res: StringBuilder); -/// Записывает в res строку для вывода в write +/// Записывает в res строку для вывода подобного Write procedure _ObjectToString(o: object; res: TextWriter); function IsUnix: boolean; @@ -4387,9 +4388,8 @@ type if a.Length=0 then begin // Алгоритм ниже не расчитан на пустые массив - // Правда для "new byte[1,0]" таким образом - // выведет "[]" вместо "[[]]" - res.Write('[]'); + loop a.Rank do res.Write('['); + loop a.Rank do res.Write(']'); exit; end; @@ -4477,7 +4477,7 @@ type if not enmr_has_next then break; end; - res.Write( if is_set then ']' else ']' ); + res.Write( if is_set then '}' else ']' ); exit; end; @@ -4550,15 +4550,15 @@ begin exit; end; - if t.GetInterfaces.Contains(typeof(System.Collections.IEnumerable)) then + if t.GetInterfaces.Append(t).Contains(typeof(System.Collections.IEnumerable)) then begin - var typed := t.GetInterfaces.FirstOrDefault(intr->intr.IsGenericType and (intr.GetGenericTypeDefinition=typeof(IEnumerable<>))); - if (typed<>nil) and ( + var typed := t.GetInterfaces.Append(t).FirstOrDefault(intr->intr.IsGenericType and (intr.GetGenericTypeDefinition=typeof(IEnumerable<>))); + if (t=typed) or (typed<>nil) and ( // Выводим как sequence только классы, созданные yield функцией // "clyield#" это yield класс паскаля t.Name.StartsWith('clyield#') or // А все yield классы C# являются вложенными и скрытыми - (t.DeclaringType<>nil) and not t.IsPublic + t.IsNestedPrivate ) then begin res.Write('sequence of '); @@ -4567,39 +4567,94 @@ begin end; end; + var gen_args := t.GetGenericArguments; + + //TODO t.IsClass, чтобы ValueTuple пока что не ловило + if t.GetInterfaces.Contains(typeof(System.Runtime.CompilerServices.ITuple)) and t.IsClass then + begin + res.Write('('); + var any_gen_arg := false; + foreach var arg in gen_args do + begin + if any_gen_arg then + res.Write(', ') else + any_gen_arg := true; + TypeToTypeName(arg, res); + end; + res.Write(')'); + exit; + end; + var name := t.Name; if t.IsSubclassOf(typeof(Delegate)) then begin var mi := t.GetMethod('Invoke'); - if mi=nil then raise new NotImplementedException; - ObjectToStringUtils.MethodToString(mi, false, res); - exit; + // nil for System.MulticastDelegate + if mi<>nil then + begin + ObjectToStringUtils.MethodToString(mi, false, res); + exit; + end; end; - // typeof(t1) или typeof(t1<>) - // typeof(t1<>) можно проверить отдельно с .IsGenericTypeDefinition - // Но в данном случае это не нужно - if t.IsGenericType then + // "Lst(0).GetEnumerator.GetType.DeclaringType" возвращает List, а не List + // При чём этот T.IsNested возвращает true, хотя это параметр а не вложенный тип + if t.IsNested and not t.IsGenericParameter then begin - res.Write( name.Remove(name.IndexOf('`')) ); - res.Write('<'); - var any_gen_par := false; - foreach var gen_par in t.GetGenericArguments do + var parent_def := t.DeclaringType; + var parent := parent_def; + if parent.IsGenericType then begin - if any_gen_par then + // Во вложенный тип копирует все типы шаблона из внешнего класса + // class Parent { class Nested } + // На практике вложенный тип будет Parent`1+Nested`1 + // Но тут писать в res будем только + + var t_def_args := t.GetGenericTypeDefinition.GetGenericArguments; + var parent_def_args := parent_def.GetGenericArguments; + for var i := 0 to parent_def_args.Length-1 do + if t_def_args[i].Name <> parent_def_args[i].Name then + // Ожидается что всегда будет перед в примере выше + raise new NotImplementedException; + + var parent_args := new System.Type[parent_def_args.Length]; + &Array.ConstrainedCopy(gen_args,0, parent_args,0, parent_args.Length); + parent := parent_def.MakeGenericType(parent_args); + + var own_args := new System.Type[gen_args.Length-parent_def_args.Length]; + &Array.ConstrainedCopy(gen_args,parent_args.Length, own_args,0, own_args.Length); + gen_args := own_args; + + end; + TypeToTypeName(parent, res); + res.Write('+'); + end; + + if gen_args.Count<>0 then + begin + res.Write(name.Remove(name.LastIndexOf('`'))); + res.Write('<'); + var any_gen_arg := false; + foreach var arg in gen_args do + begin + if any_gen_arg then res.Write(', ') else - any_gen_par := true; - TypeToTypeName(gen_par, res); + any_gen_arg := true; + TypeToTypeName(arg, res); end; res.Write('>'); exit; end; + if t.IsGenericParameter then + res.Write('['); res.Write(name); + if t.IsGenericParameter then + res.Write(']'); end; procedure TypeToTypeName(t: System.Type; res: StringBuilder) := -TypeToTypeName(t, new StringWriter(res)); + TypeToTypeName(t, new StringWriter(res)); procedure TypeName(o: object; res: TextWriter); begin @@ -4624,7 +4679,7 @@ begin TypeToTypeName(t, res); end; procedure TypeName(o: object; res: StringBuilder) := -TypeName(o, new StringWriter(res)); + TypeName(o, new StringWriter(res)); function TypeToTypeName(t: System.Type): string; begin @@ -4641,9 +4696,9 @@ begin end; procedure _ObjectToString(o: object; res: TextWriter) := -ObjectToStringUtils.Append(o, new Stack, res); + ObjectToStringUtils.Append(o, new Stack, res); procedure _ObjectToString(o: object; res: StringBuilder) := -_ObjectToString(o, new StringWriter(res)); + _ObjectToString(o, new StringWriter(res)); function _ObjectToString(o: object): string; begin var res := new StringBuilder; diff --git a/TreeConverter/TreeConversion/ISyntaxTreeVisitor.cs b/TreeConverter/TreeConversion/ISyntaxTreeVisitor.cs new file mode 100644 index 000000000..b3dec88a8 --- /dev/null +++ b/TreeConverter/TreeConversion/ISyntaxTreeVisitor.cs @@ -0,0 +1,12 @@ +using System; +using System.Collections.Generic; +using System.Linq; +using System.Text; + +namespace PascalABCCompiler.TreeConverter.TreeConversion +{ + public interface ISyntaxTreeVisitor + { + string[] FilesExtensions { get; } + } +} diff --git a/TreeConverter/TreeConversion/SyntaxTreeToSemanticTreeConverter.cs b/TreeConverter/TreeConversion/SyntaxTreeToSemanticTreeConverter.cs index eef4b9beb..25191abc2 100644 --- a/TreeConverter/TreeConversion/SyntaxTreeToSemanticTreeConverter.cs +++ b/TreeConverter/TreeConversion/SyntaxTreeToSemanticTreeConverter.cs @@ -9,14 +9,18 @@ ***************************************************************************/ using PascalABCCompiler.TreeRealization; +using System; using System.Collections.Generic; +using PascalABCCompiler.TreeConverter; +using System.IO; namespace PascalABCCompiler.TreeConverter { public class SyntaxTreeToSemanticTreeConverter { - private PascalABCCompiler.TreeConverter.syntax_tree_visitor stv=new PascalABCCompiler.TreeConverter.syntax_tree_visitor(); - + private PascalABCCompiler.TreeConverter.syntax_tree_visitor stv = new syntax_tree_visitor(); + private PascalABCCompiler.TreeConverter.TreeConversion.SyntaxTreeVisitorsController stvController = + new PascalABCCompiler.TreeConverter.TreeConversion.SyntaxTreeVisitorsController(); public SyntaxTreeToSemanticTreeConverter() { //(ssyy) запоминаем visitor @@ -24,7 +28,7 @@ namespace PascalABCCompiler.TreeConverter } //TODO: Разобраться, где использутеся. - public SymbolTable.TreeConverterSymbolTable SymbolTable + public SymbolTable.TreeConverterSymbolTable SymbolTable { get { @@ -75,8 +79,9 @@ namespace PascalABCCompiler.TreeConverter PascalABCCompiler.TreeRealization.unit_node_list UsedUnits, List ErrorsList, List WarningsList, PascalABCCompiler.Errors.SyntaxError parser_error, System.Collections.Hashtable bad_nodes, TreeRealization.using_namespace_list namespaces, Dictionary docs, bool debug, bool debugging, bool for_intellisense, List CompiledVariables) { + stv = stvController.SelectVisitor(Path.GetExtension(SyntaxUnit.file_name)); //convertion_data_and_alghoritms.__i = 0; - stv.parser_error=parser_error; + stv.parser_error=parser_error; stv.bad_nodes_in_syntax_tree = bad_nodes; stv.referenced_units=UsedUnits; //stv.comp_units=UsedUnits; @@ -95,14 +100,15 @@ namespace PascalABCCompiler.TreeConverter stv.for_intellisense = for_intellisense; SystemLibrary.SystemLibrary.syn_visitor = stv; SetSemanticRules(SyntaxUnit); - + foreach (SyntaxTree.compiler_directive cd in SyntaxUnit.compiler_directives) - cd.visit(stv); + stv.ProcessNode(cd); stv.DirectivesToNodesLinks = CompilerDirectivesToSyntaxTreeNodesLinker.BuildLinks(SyntaxUnit, ErrorsList); //MikhailoMMX добавил передачу списка ошибок (02.10.10) - SyntaxUnit.visit(stv); + stv.ProcessNode(SyntaxUnit); + CompiledVariables.AddRange(stv.CompiledVariables); /*SyntaxTree.program_module pmod=SyntaxUnit as SyntaxTree.program_module; if (pmod!=null) @@ -128,8 +134,9 @@ namespace PascalABCCompiler.TreeConverter PascalABCCompiler.Errors.SyntaxError parser_error, System.Collections.Hashtable bad_nodes, TreeRealization.using_namespace_list interface_namespaces, TreeRealization.using_namespace_list imlementation_namespaces, Dictionary docs, bool debug, bool debugging, bool for_intellisense, List CompiledVariables) { - //if (ErrorsList.Count>0) throw ErrorsList[0]; - stv.parser_error=parser_error; + stv = stvController.SelectVisitor(Path.GetExtension(SyntaxUnit.file_name)); + //if (ErrorsList.Count>0) throw ErrorsList[0]; + stv.parser_error=parser_error; stv.bad_nodes_in_syntax_tree = bad_nodes; stv.referenced_units = UsedUnits; diff --git a/TreeConverter/TreeConversion/SyntaxTreeVisitorsController.cs b/TreeConverter/TreeConversion/SyntaxTreeVisitorsController.cs new file mode 100644 index 000000000..32a0afbe6 --- /dev/null +++ b/TreeConverter/TreeConversion/SyntaxTreeVisitorsController.cs @@ -0,0 +1,77 @@ +using System; +using System.Collections.Generic; +using System.Linq; +using System.Text; + +using PascalABCCompiler.SyntaxTree; +using PascalABCCompiler.TreeConverter; +using System.IO; + + +namespace PascalABCCompiler.TreeConverter.TreeConversion +{ + class SyntaxTreeVisitorsController + { + private List syntaxTreeVisitors = new List(); + public List SyntaxTreeVisitors + { + get + { + return syntaxTreeVisitors; + } + } + public SyntaxTreeVisitorsController() + { + ReloadConverters(); + } + public void ReloadConverters() + { + syntaxTreeVisitors.Clear(); + syntaxTreeVisitors.Add(new syntax_tree_visitor()); + string dir = System.IO.Path.GetDirectoryName(System.Reflection.Assembly.GetExecutingAssembly().ManifestModule.FullyQualifiedName); + DirectoryInfo di = new DirectoryInfo(dir); + FileInfo[] dllfiles = di.GetFiles("*SyntaxTreeVisitor.dll"); + System.Reflection.Assembly asssembly = null; + foreach (FileInfo fi in dllfiles) + { + asssembly = System.Reflection.Assembly.LoadFile(fi.FullName); + try + { + Type[] types = asssembly.GetTypes(); + if (asssembly != null) + { + foreach (Type type in types) + { + if (type.Name.IndexOf("syntax_tree_visitor") >= 0) + { + Object obj = Activator.CreateInstance(type); + if (obj is syntax_tree_visitor) + { + syntaxTreeVisitors.Add((syntax_tree_visitor)obj); + } + } + } + } + } + catch (System.Reflection.ReflectionTypeLoadException e) + { + Console.Error.WriteLine("SyntaxTreeVisitor {0} reflection error {1}", Path.GetFileName(fi.FullName), e); + foreach (var le in e.LoaderExceptions) + Console.Error.WriteLine(le); + } + catch (Exception e) + { + Console.Error.WriteLine("SyntaxTreeVisitor {0} loading error {1}", Path.GetFileName(fi.FullName), e); + } + } + } + public syntax_tree_visitor SelectVisitor(string ext) + { + foreach (syntax_tree_visitor stv in SyntaxTreeVisitors) + foreach (string stvfext in stv.FilesExtensions) + if (stvfext.ToLower() == ext) + return stv; + return null; + } + } +} diff --git a/TreeConverter/TreeConversion/syntax_tree_visitor.cs b/TreeConverter/TreeConversion/syntax_tree_visitor.cs index d097a5781..c70129a81 100644 --- a/TreeConverter/TreeConversion/syntax_tree_visitor.cs +++ b/TreeConverter/TreeConversion/syntax_tree_visitor.cs @@ -38,11 +38,19 @@ namespace PascalABCCompiler.TreeConverter } }*/ - public partial class syntax_tree_visitor : SyntaxTree.WalkingVisitorNew // SSM 02.01.17 менять на визитор с другим порядком обхода можно, но бессмысленно + public partial class syntax_tree_visitor : SyntaxTree.WalkingVisitorNew, TreeConversion.ISyntaxTreeVisitor // SSM 02.01.17 менять на визитор с другим порядком обхода можно, но бессмысленно // Порядок обхода не важен поскольку все узлы visit переопределяются // SSM 02.01.17 Использование ReplaceStatement из BaseChangeVisitor плохо изучено - что-то не работает // Поэтому используется явный Parent и ReplaceStatement из узла statement_list { + private string[] filesExtensions = { ".pas" }; + public virtual string[] FilesExtensions + { + get + { + return filesExtensions; + } + } public SymbolTable.PrimaryScope MainScope { get diff --git a/TreeConverter/TreeConverter.csproj b/TreeConverter/TreeConverter.csproj index 9e35410f9..b29cafe8f 100644 --- a/TreeConverter/TreeConverter.csproj +++ b/TreeConverter/TreeConverter.csproj @@ -112,6 +112,7 @@ + Code @@ -169,6 +170,7 @@ + Code