diff --git a/Compiler/Compiler.cs b/Compiler/Compiler.cs index 8212d7235..31cd01f78 100644 --- a/Compiler/Compiler.cs +++ b/Compiler/Compiler.cs @@ -2306,8 +2306,8 @@ namespace PascalABCCompiler if (ClearAfterCompilation) ClearAll(); - - OnChangeCompilerState(this, CompilerState.Ready, null); + if (!need_recompiled) + OnChangeCompilerState(this, CompilerState.Ready, null); if (ErrorsList.Count > 0) { return null; diff --git a/Compiler/PCU/PCUFileFormatVersion.cs b/Compiler/PCU/PCUFileFormatVersion.cs index 4284790c3..e8fce5107 100644 --- a/Compiler/PCU/PCUFileFormatVersion.cs +++ b/Compiler/PCU/PCUFileFormatVersion.cs @@ -6,6 +6,6 @@ namespace PascalABCCompiler.PCU { public static class PCUFileFormatVersion { - public static System.Int16 Version = 115; + public static System.Int16 Version = 116; } } diff --git a/Compiler/PCU/PCUReader.cs b/Compiler/PCU/PCUReader.cs index 9d5928b60..274ef6c02 100644 --- a/Compiler/PCU/PCUReader.cs +++ b/Compiler/PCU/PCUReader.cs @@ -2107,8 +2107,8 @@ namespace PascalABCCompiler.PCU //} } - private definition_node CreateInterfaceCommonType(string name, int offset) - { + private definition_node CreateInterfaceCommonType(string name, int offset) + { definition_node dn = null; if (members.TryGetValue(offset, out dn)) return dn as common_type_node; @@ -2116,7 +2116,7 @@ namespace PascalABCCompiler.PCU bool is_interface = br.ReadBoolean(); int ind = br.ReadInt32(); - + if (is_interface)//пропускаем флаг - интерфейсности { name = GetString(br.ReadInt32()); @@ -2125,10 +2125,12 @@ namespace PascalABCCompiler.PCU { name = br.ReadString(); } - //br.ReadInt32(); + //br.ReadInt32(); //Читаем, является ли тип интерфейсом bool type_is_interface = (br.ReadByte() == 1); + bool type_is_class = (br.ReadByte() == 1); + //Читаем, является ли тип делегатом bool type_is_delegate = (br.ReadByte() == 1); @@ -2164,35 +2166,28 @@ namespace PascalABCCompiler.PCU ctn.generic_params = type_params; } AddMember(ctn, offset); - - int_members.Insert(0,ctn); + + int_members.Insert(0, ctn); common_type_node saved_ctn = ctn; type_node base_type = GetTypeReference(); bool is_value_type = br.ReadBoolean(); - //Читаем поддерживаемые интерфейсы List interf_implemented = ReadImplementingInterfaces(); - //int interf_count = br.ReadInt32(); - //List interf_implemented = new List(interf_count); - //for (int i = 0; i < interf_count; i++) - //{ - // interf_implemented.Add(GetTypeReference()); - //} - constant_node low_val=null; - constant_node upper_val=null; + constant_node low_val = null; + constant_node upper_val = null; SemanticTree.type_access_level tal = (SemanticTree.type_access_level)br.ReadByte(); SemanticTree.type_special_kind tsk = (SemanticTree.type_special_kind)br.ReadByte(); ctn.SetIsSealed(br.ReadBoolean()); ctn.SetIsAbstract(br.ReadBoolean()); ctn.SetIsStatic(br.ReadBoolean()); ctn.IsPartial = br.ReadBoolean(); - + if (tsk == SemanticTree.type_special_kind.diap_type) { - low_val = CreateExpression() as constant_node; - upper_val = CreateExpression() as constant_node; + low_val = CreateExpression() as constant_node; + upper_val = CreateExpression() as constant_node; } - + if (type_is_interface) { //Добавляем ссылки на области видимости предков интерфейса @@ -2203,12 +2198,10 @@ namespace PascalABCCompiler.PCU } iscope.TopInterfaceScopeArray = interf_scopes.ToArray(); } - //ctn = new wrapped_common_type_node(this, base_type, name, tal, cun.namespaces[0], scope, null, offset); - //AddMember(ctn, offset); - //int_members.Insert(0,ctn); ctn.SetBaseType(base_type); ctn.IsInterface = type_is_interface; ctn.IsDelegate = type_is_delegate; + ctn.is_class = type_is_class; ctn.ImplementingInterfaces.AddRange(interf_implemented); ctn.internal_is_value = is_value_type; ctn.type_special_kind = tsk; @@ -2226,13 +2219,13 @@ namespace PascalABCCompiler.PCU if (CanReadObject()) elemnet_type = GetTypeReference(); ctn.element_type = elemnet_type; - if (ctn.type_special_kind != SemanticTree.type_special_kind.set_type) + if (ctn.type_special_kind != SemanticTree.type_special_kind.set_type) { - SystemLibrary.SystemLibrary.init_reference_type(ctn); + SystemLibrary.SystemLibrary.init_reference_type(ctn); } if (ctn.type_special_kind == SemanticTree.type_special_kind.set_type) { - ctn = compilation_context.AddTypeToSetTypeList(ctn); + ctn = compilation_context.AddTypeToSetTypeList(ctn); if (saved_ctn != ctn) { RemoveMember(offset, saved_ctn); @@ -2242,7 +2235,7 @@ namespace PascalABCCompiler.PCU } if (ctn.type_special_kind == SemanticTree.type_special_kind.typed_file) { - ctn = compilation_context.AddTypeToTypedFileList(ctn); + ctn = compilation_context.AddTypeToTypedFileList(ctn); if (saved_ctn != ctn) { RemoveMember(offset, saved_ctn); @@ -2252,50 +2245,45 @@ namespace PascalABCCompiler.PCU } br.ReadInt32();//comprehensive unit; ctn.attributes.AddRange(GetAttributes()); - //common_namespace_node ns = cun.namespaces[0]; byte flag = br.ReadByte(); - int def_prop_off=0; + int def_prop_off = 0; if (flag == 1) { def_prop_off = br.ReadInt32(); } - location loc= ReadDebugInfo(); + location loc = ReadDebugInfo(); ctn.loc = loc; if (type_is_delegate) { SystemLibrary.SystemLibrary.type_constructor.AddOperatorsToDelegate(ctn, loc); } - - //создаем scope для класса - //ctn = new wrapped_common_type_node(this, base_type, name, tal, ns, scope, loc, offset); - //members[offset] = ctn; - //AddMember(ctn, offset); + class_names[ctn] = AddClassMemberNames(scope); - if (flag == 1) ctn.default_property = GetPropertyNode(def_prop_off); + if (flag == 1) ctn.default_property = GetPropertyNode(def_prop_off); //ivan - if (ctn.IsEnum) + if (ctn.IsEnum) { - AddEnumOperators(ctn); - MakeTypeAsOrdinal(ctn,0,class_names.Count); - ctn.add_additional_enum_operations(); + AddEnumOperators(ctn); + MakeTypeAsOrdinal(ctn, 0, class_names.Count); + ctn.add_additional_enum_operations(); } if (ctn.type_special_kind == SemanticTree.type_special_kind.diap_type) { - type_constructor.add_convertions_to_diap(ctn,low_val,upper_val); + type_constructor.add_convertions_to_diap(ctn, low_val, upper_val); } if (ctn.type_special_kind == SemanticTree.type_special_kind.array_kind) { - if (!(ctn.element_type is compiled_type_node)) - { - type_constructor.make_array_interface(ctn); - } + if (!(ctn.element_type is compiled_type_node)) + { + type_constructor.make_array_interface(ctn); + } } if (ctn.is_value_type) { } //RestoreAllFields(ctn); - if(!waited_types_to_restore_fields.Contains(ctn)) + if (!waited_types_to_restore_fields.Contains(ctn)) waited_types_to_restore_fields.Add(ctn); if (type_is_delegate) @@ -2308,19 +2296,14 @@ namespace PascalABCCompiler.PCU dii.parameters.AddRange(invoke_method.parameters); ctn.add_internal_interface(dii); } - - /*if (ctn.type_special_kind == PascalABCCompiler.SemanticTree.type_special_kind.array_wrapper) - { - bounded_array_interface bai = new bounded_array_interface(oti_indexer, ctn.element_type, cpn, oti_indexer.lower_value.type, int_arr); - ctn.add_internal_interface(bai); - }*/ + if (type_is_interface) { RestoreAllFields(ctn); } if (ctn.is_value) { - RestoreAllFields(ctn); + RestoreAllFields(ctn); } if (ctn.is_generic_type_definition) { @@ -2333,13 +2316,9 @@ namespace PascalABCCompiler.PCU } } } - /*if (ctn.type_special_kind == SemanticTree.type_special_kind.array_wrapper) - { - RestoreAllFields(ctn); - }*/ - - return ctn; - } + + return ctn; + } private void MakeTypeAsOrdinal(common_type_node ctn, int low_val, int upper_val) { diff --git a/Compiler/PCU/PCUWriter.cs b/Compiler/PCU/PCUWriter.cs index d0a3353d0..2a0289ed3 100644 --- a/Compiler/PCU/PCUWriter.cs +++ b/Compiler/PCU/PCUWriter.cs @@ -2496,23 +2496,19 @@ namespace PascalABCCompiler.PCU return sizeof(byte) + sizeof(int); } - private void VisitTypeDefinition(common_type_node type) - { + private void VisitTypeDefinition(common_type_node type) + { int offset = 0; if (is_interface == true) offset = SavePositionAndConstPool(type); - else offset = SavePositionAndImplementationPool(type); - bw.Write((byte)type.semantic_node_type); - bw.Write(is_interface); + else offset = SavePositionAndImplementationPool(type); + bw.Write((byte)type.semantic_node_type); + bw.Write(is_interface); bw.Write(type_entity_index++); - if (is_interface == true) - bw.Write(GetNameIndex(type)); - else - bw.Write(type.name); - /*if (type.base_type != null) - WriteTypeReference(type.base_type); - else*/ + if (is_interface == true) + bw.Write(GetNameIndex(type)); + else + bw.Write(type.name); - //Пишем, является ли данный класс интерфейсом if (type.IsInterface) { bw.Write((byte)1); @@ -2522,7 +2518,15 @@ namespace PascalABCCompiler.PCU bw.Write((byte)0); } - //Пишем, является ли данный класс делегатом + if (type.is_class) + { + bw.Write((byte)1); + } + else + { + bw.Write((byte)0); + } + if (type.IsDelegate) { bw.Write((byte)1); @@ -2531,7 +2535,7 @@ namespace PascalABCCompiler.PCU { bw.Write((byte)0); } - + //Является ли тип описанием дженерика if (type.is_generic_type_definition) { @@ -2552,10 +2556,7 @@ namespace PascalABCCompiler.PCU int base_class_off = (int)bw.BaseStream.Position; bw.Seek(GetSizeOfReference(type.base_type), SeekOrigin.Current); - - //(ssyy) На кой чёрт это надо? - //WriteTypeReference(SystemLibrary.SystemLibrary.object_type); - //WriteTypeReference(type.base_type); + bw.Write(type.internal_is_value); //Пишем поддерживаемые интерфейсы @@ -2563,8 +2564,8 @@ namespace PascalABCCompiler.PCU //WriteImplementingInterfaces(type); int interface_impl_off = (int)bw.BaseStream.Position; int seek_off = sizeof(int); - for (int k=0; k(s: TypedSet): HashSet; class function operator implicit(s: HashSet): TypedSet; + //class function operator implicit(a: array of T): TypedSet; function Count: integer := ht.Count; procedure Print(delim: string := ' '); procedure Println(delim: string := ' '); @@ -3369,6 +3370,17 @@ begin Result := ts; end; +///-- +{class function TypedSet.operator implicit(a: array of T): TypedSet; +begin + var ts := new TypedSet(); + foreach key: T in a do + begin + ts.ht[key] := key; + end; + Result := ts; +end;} + ///-- function TypedSet.ToString: string; var @@ -5193,33 +5205,6 @@ begin Result := sb.ToString; end;} -function ReadLexem(f: Text): string; -begin - if f.fi = nil then - raise new System.IO.IOException(GetTranslation(FILE_NOT_ASSIGNED)); - if f.sr = nil then - raise new System.IO.IOException(GetTranslation(FILE_NOT_OPENED_FOR_READING)); - var i: integer; - repeat - i := f.sr.Read(); - until not char.IsWhiteSpace(char(i)); // pass spaces - if i=-1 then - raise new System.IO.IOException(GetTranslation(READ_LEXEM_AFTER_END_OF_TEXT_FILE)); - var c := char(i); - var sb := System.Text.StringBuilder.Create; - repeat - sb.Append(c); - i := f.sr.Peek(); - if i = -1 then - break; - c := char(i); - if char.IsWhiteSpace(c) then - break; - f.sr.Read(); - until False; // accumulate nonspaces - Result := sb.ToString; -end; - // ----------------------------------------------------- // IOStandardSystem: implementation // ----------------------------------------------------- @@ -6447,6 +6432,34 @@ begin Result := ReadBoolean(f); Readln(f); end; + +function ReadLexem(f: Text): string; +begin + if f.fi = nil then + raise new System.IO.IOException(GetTranslation(FILE_NOT_ASSIGNED)); + if f.sr = nil then + raise new System.IO.IOException(GetTranslation(FILE_NOT_OPENED_FOR_READING)); + var i: integer; + repeat + i := f.sr.Read(); + until not char.IsWhiteSpace(char(i)); // pass spaces + if i=-1 then + raise new System.IO.IOException(GetTranslation(READ_LEXEM_AFTER_END_OF_TEXT_FILE)); + var c := char(i); + var sb := System.Text.StringBuilder.Create; + repeat + sb.Append(c); + i := f.sr.Peek(); + if i = -1 then + break; + c := char(i); + if char.IsWhiteSpace(c) then + break; + f.sr.Read(); + until False; // accumulate nonspaces + Result := sb.ToString; +end; + // ----------------------------------------------------- // TextFile methods // ----------------------------------------------------- @@ -6982,6 +6995,7 @@ begin begin f.sr := new StreamReader(f.fi.FullName, DefaultEncoding); (CurrentIOSystem as IOStandardSystem).tr := f.sr; + (CurrentIOSystem as IOStandardSystem).realbuflen := -1; _IsPipedRedirected := True; _IsPipedRedirectedQuery := True; end; @@ -7032,6 +7046,11 @@ begin f.sr.BaseStream.Position := 0; f.sr.DiscardBufferedData; end; + if f = input then + begin + (CurrentIOSystem as IOStandardSystem).tr := f.sr; + (CurrentIOSystem as IOStandardSystem).realbuflen := -1; + end; end; procedure Reset(f: Text; name: string) := Reset(f, name, DefaultEncoding); diff --git a/TestSuite/CompilationSamples/PT4MakerNetX.pas b/TestSuite/CompilationSamples/PT4MakerNetX.pas index 7d6f981ba..3517d552d 100644 --- a/TestSuite/CompilationSamples/PT4MakerNetX.pas +++ b/TestSuite/CompilationSamples/PT4MakerNetX.pas @@ -1,9 +1,9 @@ /// Конструктор учебных заданий для задачника Programming Taskbook. -/// Версия 1.6 от 28.07.2018 (С) М. Э. Абрамян, 2016-2018. +/// Версия 1.7 от 28.10.2020 (С) М. Э. Абрамян, 2016-2020. /// Все компоненты конструктора могут вызываться либо как классовые методы класса pt, /// либо как обычные константы и процедуры. unit PT4MakerNetX; - + interface const @@ -659,7 +659,7 @@ var yd, yr, ye, nd, nr, pr, wd: integer; nt, ut, fd, fr: boolean; fmt: string; - tasks := new List(100); + tasks := new List(200); procedure Show(s: string); begin @@ -1213,7 +1213,8 @@ begin begin tasks.Add(e); GroupKey := GroupKey + Copy(e.Name, 5, 100); - end; + end; + tasks := tasks.OrderBy(e -> e.Name).ToList; // Сортировка задач! if tasks.Count = 0 then begin Show('Группа ' + GroupName + ' не содержит заданий'#13#10+ diff --git a/TestSuite/CompilationSamples/SF.pas b/TestSuite/CompilationSamples/SF.pas index d508be097..a742cdbeb 100644 --- a/TestSuite/CompilationSamples/SF.pas +++ b/TestSuite/CompilationSamples/SF.pas @@ -1,5 +1,30 @@ unit SF; +type + int = integer; + bool = boolean; + bi = BigInteger; + FunI = () -> int; + FunR = () -> real; + FunS = () -> string; + FunII = int -> int; + FunIR = int -> real; + FunIS = int -> string; + FunRI = real -> int; + FunRR = real -> real; + FunRS = real -> string; + FunSI = string -> int; + FunSR = string -> real; + FunSS = string -> string; + Pred = () -> bool; + PredI = int -> bool; + PredR = real -> bool; + PredS = string -> bool; + Act = () -> (); + ProcI = int -> (); + ProcR = real -> (); + ProcS = string -> (); + procedure Pr(params a: array of object) := Print(a); procedure Pr(o: object) := Print(o); procedure Pr(s: string) := Print(s); @@ -126,6 +151,9 @@ function Av(Self: sequence of integer): real; extensionmethod := Self.Average; /// Возвращает среднее элементов последовательности function Av(Self: sequence of real): real; extensionmethod := Self.Average; +/// Возвращает количество элементов последовательности +function Cnt(Self: sequence of T): integer; extensionmethod := Self.Count; + function Dst(Self: sequence of T): sequence of T; extensionmethod := Self.Distinct; function Ord(Self: sequence of T): sequence of T; extensionmethod := Self.Order; @@ -195,4 +223,15 @@ procedure Tr(a: array of T; transform: T->T) := a.Transform(transform); function H(Self: array of T): integer; extensionmethod := Self.High; +///-- +procedure __InitModule__; +begin +end; + +///-- +procedure __FinalizeModule__; +begin +end; + + end. \ No newline at end of file diff --git a/TestSuite/CompilationSamples/School.pas b/TestSuite/CompilationSamples/School.pas index 52cec2eef..ccc3f9857 100644 --- a/TestSuite/CompilationSamples/School.pas +++ b/TestSuite/CompilationSamples/School.pas @@ -755,4 +755,13 @@ end; {$endregion} +///-- +procedure __InitModule__; +begin +end; + +///-- +procedure __FinalizeModule__; +begin +end; end. \ No newline at end of file diff --git a/TestSuite/formatter_tests/input/PT4MakerNetX.pas b/TestSuite/formatter_tests/input/PT4MakerNetX.pas index 7d6f981ba..3517d552d 100644 --- a/TestSuite/formatter_tests/input/PT4MakerNetX.pas +++ b/TestSuite/formatter_tests/input/PT4MakerNetX.pas @@ -1,9 +1,9 @@ /// Конструктор учебных заданий для задачника Programming Taskbook. -/// Версия 1.6 от 28.07.2018 (С) М. Э. Абрамян, 2016-2018. +/// Версия 1.7 от 28.10.2020 (С) М. Э. Абрамян, 2016-2020. /// Все компоненты конструктора могут вызываться либо как классовые методы класса pt, /// либо как обычные константы и процедуры. unit PT4MakerNetX; - + interface const @@ -659,7 +659,7 @@ var yd, yr, ye, nd, nr, pr, wd: integer; nt, ut, fd, fr: boolean; fmt: string; - tasks := new List(100); + tasks := new List(200); procedure Show(s: string); begin @@ -1213,7 +1213,8 @@ begin begin tasks.Add(e); GroupKey := GroupKey + Copy(e.Name, 5, 100); - end; + end; + tasks := tasks.OrderBy(e -> e.Name).ToList; // Сортировка задач! if tasks.Count = 0 then begin Show('Группа ' + GroupName + ' не содержит заданий'#13#10+ diff --git a/TestSuite/units/u_questiondot1.pas b/TestSuite/units/u_questiondot1.pas new file mode 100644 index 000000000..c426d8406 --- /dev/null +++ b/TestSuite/units/u_questiondot1.pas @@ -0,0 +1,7 @@ +unit u_questiondot1; + +type + t1 = class end; + + +end. \ No newline at end of file diff --git a/TestSuite/usesunits/use_questiondot1.pas b/TestSuite/usesunits/use_questiondot1.pas new file mode 100644 index 000000000..366799b26 --- /dev/null +++ b/TestSuite/usesunits/use_questiondot1.pas @@ -0,0 +1,7 @@ +uses u_questiondot1; + +begin + var a: t1 := nil; + var s := a?.ToString; + assert(string.IsNullOrEmpty(s)); +end. \ No newline at end of file diff --git a/TreeConverter/NetWrappers/NetHelper.cs b/TreeConverter/NetWrappers/NetHelper.cs index 3921e1de1..93471b4e4 100644 --- a/TreeConverter/NetWrappers/NetHelper.cs +++ b/TreeConverter/NetWrappers/NetHelper.cs @@ -1106,7 +1106,8 @@ namespace PascalABCCompiler.NetHelper function_node fn = si.sym_info as function_node; if ((fn.return_value_type == to || fn.return_value_type.original_generic == to) && fn.parameters.Count == 1 && - (fn.parameters[0].type == from || fn.parameters[0].type.original_generic == from)) + (fn.parameters[0].type == from || fn.parameters[0].type.original_generic == from) + || fn.parameters[0].type.type_special_kind == type_special_kind.array_kind && fn.parameters[0].type.element_type.is_generic_parameter) { return fn; } diff --git a/TreeConverter/TreeRealization/types.cs b/TreeConverter/TreeRealization/types.cs index 557c44fca..3c3d2ceb1 100644 --- a/TreeConverter/TreeRealization/types.cs +++ b/TreeConverter/TreeRealization/types.cs @@ -3662,7 +3662,8 @@ namespace PascalABCCompiler.TreeRealization //TODO: Доопределить. public override function_node get_implicit_conversion_to(type_node ctn) { - compiled_type_node cctn = ctn as compiled_type_node; + // То есть получается, что конвертировать откомпилированный тип в неоткомпилированный нельзя несмотря на то что есть extension оператор + var cctn = ctn as compiled_type_node; if (cctn == null) { return null; @@ -3673,6 +3674,17 @@ namespace PascalABCCompiler.TreeRealization fn = NetHelper.NetHelper.get_implicit_conversion(this, this, cctn, scope); if (fn is compiled_function_node) _implicit_convertions_to.Add(cctn, fn); + else if (fn == null && this.type_special_kind == SemanticTree.type_special_kind.array_kind && this.base_type.Scope != null) + { + fn = NetHelper.NetHelper.get_implicit_conversion(this.base_type as compiled_type_node, this.base_type as compiled_type_node, cctn, this.base_type.Scope as NetHelper.NetTypeScope); + if (fn != null) + { + List instance_params = new List(); + instance_params.Add(this.element_type); + fn = fn.get_instance(instance_params, false, null); + return fn; + } + } else if (fn == null && (this.is_generic_type_instance || cctn.is_generic_type_instance)) { List instance_params1 = this.instance_params; diff --git a/VisualPascalABCNET/Form1.cs b/VisualPascalABCNET/Form1.cs index aeb7c3eee..c373ab403 100644 --- a/VisualPascalABCNET/Form1.cs +++ b/VisualPascalABCNET/Form1.cs @@ -840,7 +840,7 @@ namespace VisualPascalABC private void StartMenuItem_Click(object sender, EventArgs e) { WorkbenchServiceFactory.RunService.Run(true); - if (VisualEnvironmentCompiler.Compiler != null && VisualEnvironmentCompiler.Compiler.ErrorsList.Count == 0) + /*if (VisualEnvironmentCompiler.Compiler != null && VisualEnvironmentCompiler.Compiler.ErrorsList.Count == 0) { var Percent = VisualEnvironmentCompiler.Compiler.PABCCodeHealth; if (Percent > 0) @@ -856,33 +856,7 @@ namespace VisualPascalABC var PM100 = 100 - Percent; HealthLabel.BackColor = Color.FromArgb(c.R - PM100 - 20, c.G - PM100 - 20, c.B - PM100 - 20); } - } - - - /*if (VisualEnvironmentCompiler.StandartCompiler != null && - VisualEnvironmentCompiler.StandartCompiler.LinesCompiled > 1000) - return; - var root = VisualEnvironmentCompiler?.StandartCompiler?.CurrentCompilationUnit?.SyntaxTree; - - if (root == null) - return; - if (VisualEnvironmentCompiler.StandartCompiler.CurrentCompilationUnit.SemanticTree == null) - return; - var stat = new SyntaxVisitors.ABCStatisticsVisitor(); - stat.ProcessNode(root); - var Percent = stat.CalcHealth(out int n, out int p); - - if (Percent >= 100) - { - HealthLabel.Text = ""; - return; - } - HealthLabel.Text = $"{Percent}%"; - - var c = SystemColors.Control; - var PM100 = 100 - Percent; - HealthLabel.BackColor = Color.FromArgb(c.R - PM100 - 20, c.G - PM100 - 20, c.B - PM100 - 20); - */ + }*/ } private void Form1_KeyUp(object sender, KeyEventArgs e) diff --git a/bin/Lib/BlockFileOfT.pas b/bin/Lib/BlockFileOfT.pas index c3b6c371a..829863a28 100644 --- a/bin/Lib/BlockFileOfT.pas +++ b/bin/Lib/BlockFileOfT.pas @@ -830,4 +830,13 @@ end; {$endregion Utils} +///-- +procedure __InitModule__; +begin +end; + +///-- +procedure __FinalizeModule__; +begin +end; end. \ No newline at end of file diff --git a/bin/Lib/NumLibABC.pas b/bin/Lib/NumLibABC.pas index ef5d09186..5948da0bd 100644 --- a/bin/Lib/NumLibABC.pas +++ b/bin/Lib/NumLibABC.pas @@ -2776,5 +2776,13 @@ end; {$endregion} //---------------------------------------- +///-- +procedure __InitModule__; +begin +end; +///-- +procedure __FinalizeModule__; +begin +end; end. \ No newline at end of file diff --git a/bin/Lib/PABCSystem.pas b/bin/Lib/PABCSystem.pas index f4efc4b42..d99c2ea33 100644 --- a/bin/Lib/PABCSystem.pas +++ b/bin/Lib/PABCSystem.pas @@ -492,6 +492,7 @@ type function ToString: string; override; class function operator implicit(s: TypedSet): HashSet; class function operator implicit(s: HashSet): TypedSet; + //class function operator implicit(a: array of T): TypedSet; function Count: integer := ht.Count; procedure Print(delim: string := ' '); procedure Println(delim: string := ' '); @@ -3369,6 +3370,17 @@ begin Result := ts; end; +///-- +{class function TypedSet.operator implicit(a: array of T): TypedSet; +begin + var ts := new TypedSet(); + foreach key: T in a do + begin + ts.ht[key] := key; + end; + Result := ts; +end;} + ///-- function TypedSet.ToString: string; var @@ -5193,33 +5205,6 @@ begin Result := sb.ToString; end;} -function ReadLexem(f: Text): string; -begin - if f.fi = nil then - raise new System.IO.IOException(GetTranslation(FILE_NOT_ASSIGNED)); - if f.sr = nil then - raise new System.IO.IOException(GetTranslation(FILE_NOT_OPENED_FOR_READING)); - var i: integer; - repeat - i := f.sr.Read(); - until not char.IsWhiteSpace(char(i)); // pass spaces - if i=-1 then - raise new System.IO.IOException(GetTranslation(READ_LEXEM_AFTER_END_OF_TEXT_FILE)); - var c := char(i); - var sb := System.Text.StringBuilder.Create; - repeat - sb.Append(c); - i := f.sr.Peek(); - if i = -1 then - break; - c := char(i); - if char.IsWhiteSpace(c) then - break; - f.sr.Read(); - until False; // accumulate nonspaces - Result := sb.ToString; -end; - // ----------------------------------------------------- // IOStandardSystem: implementation // ----------------------------------------------------- @@ -6447,6 +6432,34 @@ begin Result := ReadBoolean(f); Readln(f); end; + +function ReadLexem(f: Text): string; +begin + if f.fi = nil then + raise new System.IO.IOException(GetTranslation(FILE_NOT_ASSIGNED)); + if f.sr = nil then + raise new System.IO.IOException(GetTranslation(FILE_NOT_OPENED_FOR_READING)); + var i: integer; + repeat + i := f.sr.Read(); + until not char.IsWhiteSpace(char(i)); // pass spaces + if i=-1 then + raise new System.IO.IOException(GetTranslation(READ_LEXEM_AFTER_END_OF_TEXT_FILE)); + var c := char(i); + var sb := System.Text.StringBuilder.Create; + repeat + sb.Append(c); + i := f.sr.Peek(); + if i = -1 then + break; + c := char(i); + if char.IsWhiteSpace(c) then + break; + f.sr.Read(); + until False; // accumulate nonspaces + Result := sb.ToString; +end; + // ----------------------------------------------------- // TextFile methods // ----------------------------------------------------- @@ -6982,6 +6995,7 @@ begin begin f.sr := new StreamReader(f.fi.FullName, DefaultEncoding); (CurrentIOSystem as IOStandardSystem).tr := f.sr; + (CurrentIOSystem as IOStandardSystem).realbuflen := -1; _IsPipedRedirected := True; _IsPipedRedirectedQuery := True; end; @@ -7032,6 +7046,11 @@ begin f.sr.BaseStream.Position := 0; f.sr.DiscardBufferedData; end; + if f = input then + begin + (CurrentIOSystem as IOStandardSystem).tr := f.sr; + (CurrentIOSystem as IOStandardSystem).realbuflen := -1; + end; end; procedure Reset(f: Text; name: string) := Reset(f, name, DefaultEncoding); diff --git a/bin/Lib/PT4MakerNetX.pas b/bin/Lib/PT4MakerNetX.pas index 7d6f981ba..3517d552d 100644 --- a/bin/Lib/PT4MakerNetX.pas +++ b/bin/Lib/PT4MakerNetX.pas @@ -1,9 +1,9 @@ /// Конструктор учебных заданий для задачника Programming Taskbook. -/// Версия 1.6 от 28.07.2018 (С) М. Э. Абрамян, 2016-2018. +/// Версия 1.7 от 28.10.2020 (С) М. Э. Абрамян, 2016-2020. /// Все компоненты конструктора могут вызываться либо как классовые методы класса pt, /// либо как обычные константы и процедуры. unit PT4MakerNetX; - + interface const @@ -659,7 +659,7 @@ var yd, yr, ye, nd, nr, pr, wd: integer; nt, ut, fd, fr: boolean; fmt: string; - tasks := new List(100); + tasks := new List(200); procedure Show(s: string); begin @@ -1213,7 +1213,8 @@ begin begin tasks.Add(e); GroupKey := GroupKey + Copy(e.Name, 5, 100); - end; + end; + tasks := tasks.OrderBy(e -> e.Name).ToList; // Сортировка задач! if tasks.Count = 0 then begin Show('Группа ' + GroupName + ' не содержит заданий'#13#10+ diff --git a/bin/Lib/SF.pas b/bin/Lib/SF.pas index d508be097..a742cdbeb 100644 --- a/bin/Lib/SF.pas +++ b/bin/Lib/SF.pas @@ -1,5 +1,30 @@ unit SF; +type + int = integer; + bool = boolean; + bi = BigInteger; + FunI = () -> int; + FunR = () -> real; + FunS = () -> string; + FunII = int -> int; + FunIR = int -> real; + FunIS = int -> string; + FunRI = real -> int; + FunRR = real -> real; + FunRS = real -> string; + FunSI = string -> int; + FunSR = string -> real; + FunSS = string -> string; + Pred = () -> bool; + PredI = int -> bool; + PredR = real -> bool; + PredS = string -> bool; + Act = () -> (); + ProcI = int -> (); + ProcR = real -> (); + ProcS = string -> (); + procedure Pr(params a: array of object) := Print(a); procedure Pr(o: object) := Print(o); procedure Pr(s: string) := Print(s); @@ -126,6 +151,9 @@ function Av(Self: sequence of integer): real; extensionmethod := Self.Average; /// Возвращает среднее элементов последовательности function Av(Self: sequence of real): real; extensionmethod := Self.Average; +/// Возвращает количество элементов последовательности +function Cnt(Self: sequence of T): integer; extensionmethod := Self.Count; + function Dst(Self: sequence of T): sequence of T; extensionmethod := Self.Distinct; function Ord(Self: sequence of T): sequence of T; extensionmethod := Self.Order; @@ -195,4 +223,15 @@ procedure Tr(a: array of T; transform: T->T) := a.Transform(transform); function H(Self: array of T): integer; extensionmethod := Self.High; +///-- +procedure __InitModule__; +begin +end; + +///-- +procedure __FinalizeModule__; +begin +end; + + end. \ No newline at end of file diff --git a/bin/Lib/School.pas b/bin/Lib/School.pas index 52cec2eef..ccc3f9857 100644 --- a/bin/Lib/School.pas +++ b/bin/Lib/School.pas @@ -755,4 +755,13 @@ end; {$endregion} +///-- +procedure __InitModule__; +begin +end; + +///-- +procedure __FinalizeModule__; +begin +end; end. \ No newline at end of file diff --git a/bin/PT4/Lib/PT4ABegin.dll b/bin/PT4/Lib/PT4ABegin.dll new file mode 100644 index 000000000..639b987cf Binary files /dev/null and b/bin/PT4/Lib/PT4ABegin.dll differ diff --git a/bin/PT4/Lib/PT4ABoolean.dll b/bin/PT4/Lib/PT4ABoolean.dll new file mode 100644 index 000000000..440eed3dc Binary files /dev/null and b/bin/PT4/Lib/PT4ABoolean.dll differ diff --git a/bin/PT4/Lib/PT4ACase.dll b/bin/PT4/Lib/PT4ACase.dll new file mode 100644 index 000000000..fd45101ab Binary files /dev/null and b/bin/PT4/Lib/PT4ACase.dll differ diff --git a/bin/PT4/Lib/PT4AExam.dll b/bin/PT4/Lib/PT4AExam.dll index 408b3a941..8ab178c68 100644 Binary files a/bin/PT4/Lib/PT4AExam.dll and b/bin/PT4/Lib/PT4AExam.dll differ diff --git a/bin/PT4/Lib/PT4AIf.dll b/bin/PT4/Lib/PT4AIf.dll new file mode 100644 index 000000000..c091b87f6 Binary files /dev/null and b/bin/PT4/Lib/PT4AIf.dll differ diff --git a/bin/PT4/Lib/PT4AInteger.dll b/bin/PT4/Lib/PT4AInteger.dll new file mode 100644 index 000000000..5d7344fc3 Binary files /dev/null and b/bin/PT4/Lib/PT4AInteger.dll differ diff --git a/bin/PT4/Lib/PT4ALoopFor.dll b/bin/PT4/Lib/PT4ALoopFor.dll new file mode 100644 index 000000000..b31c0788a Binary files /dev/null and b/bin/PT4/Lib/PT4ALoopFor.dll differ diff --git a/bin/PT4/Lib/PT4ASeries.dll b/bin/PT4/Lib/PT4ASeries.dll new file mode 100644 index 000000000..0d19cec14 Binary files /dev/null and b/bin/PT4/Lib/PT4ASeries.dll differ diff --git a/bin/PT4/Lib/PT4AWhile.dll b/bin/PT4/Lib/PT4AWhile.dll new file mode 100644 index 000000000..58c55d514 Binary files /dev/null and b/bin/PT4/Lib/PT4AWhile.dll differ diff --git a/bin/PT4/loaddat.txt b/bin/PT4/loaddat.txt new file mode 100644 index 000000000..85d1459ba --- /dev/null +++ b/bin/PT4/loaddat.txt @@ -0,0 +1,12 @@ +RB +DM +ABegin +AInteger +ALoopFor +ABoolean +AIf +ACase +AWhile +ASeries +AExam +=br