This commit is contained in:
Mikhalkovich Stanislav 2020-06-21 21:46:50 +03:00
parent 973e33d3ec
commit 41656ca6aa
19 changed files with 12402 additions and 71 deletions

View file

@ -15,7 +15,7 @@ internal static class RevisionClass
public const string Major = "3"; public const string Major = "3";
public const string Minor = "6"; public const string Minor = "6";
public const string Build = "3"; public const string Build = "3";
public const string Revision = "2519"; public const string Revision = "2521";
public const string MainVersion = Major + "." + Minor; public const string MainVersion = Major + "." + Minor;
public const string FullVersion = Major + "." + Minor + "." + Build + "." + Revision; public const string FullVersion = Major + "." + Minor + "." + Build + "." + Revision;

View file

@ -1,4 +1,4 @@
%MINOR%=6 %MINOR%=6
%REVISION%=2519 %REVISION%=2521
%COREVERSION%=3 %COREVERSION%=3
%MAJOR%=3 %MAJOR%=3

Binary file not shown.

View file

@ -268,6 +268,5 @@ script=

View file

@ -1 +1 @@
3.6.3.2519 3.6.3.2521

View file

@ -1 +1 @@
!define VERSION '3.6.3.2519' !define VERSION '3.6.3.2521'

View file

@ -65,7 +65,7 @@
<Compile Include="VisitorsForLambdas\RenameOnExceptVarsVisitor.cs" /> <Compile Include="VisitorsForLambdas\RenameOnExceptVarsVisitor.cs" />
<Compile Include="VisitorsForLambdas\RenameSameVarNamesVisitor.cs" /> <Compile Include="VisitorsForLambdas\RenameSameVarNamesVisitor.cs" />
<Compile Include="VisitorsForLambdas\StandOutExprWithLambdaInForeachSequenceVisitor.cs" /> <Compile Include="VisitorsForLambdas\StandOutExprWithLambdaInForeachSequenceVisitor.cs" />
<Compile Include="YieldVisitors\IsVarRenameVisitor.cs" /> <Compile Include="YieldVisitors\CapturedLambdaInYieldVisitor.cs" />
<Compile Include="YieldVisitors\ObjectCopier\ObjectCopier.cs" /> <Compile Include="YieldVisitors\ObjectCopier\ObjectCopier.cs" />
<Compile Include="Optimization\CalcConstExprs.cs" /> <Compile Include="Optimization\CalcConstExprs.cs" />
<Compile Include="Properties\AssemblyInfo.cs" /> <Compile Include="Properties\AssemblyInfo.cs" />

View file

@ -0,0 +1,77 @@
// 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;
using System.Collections.Generic;
using System.Linq;
using System.Text;
using System.Threading.Tasks;
using PascalABCCompiler;
using PascalABCCompiler.SyntaxTree;
namespace SyntaxVisitors
{
public class CapturedLambdaInYieldVisitor : BaseChangeVisitor
{
public CapturedLambdaInYieldVisitor()
{
}
public static CapturedLambdaInYieldVisitor New
{
get { return new CapturedLambdaInYieldVisitor(); }
}
public static void Accept(procedure_definition pd)
{
New.ProcessNode(pd);
}
int ynum = 0;
public string CreateNameForLambdaInYield()
{
ynum += 1;
return "@RenLamInYield" + ynum + "$";
}
public override void visit(yield_node yn)
{
if (yn.ex is function_lambda_definition)
{
syntax_tree_node sn = yn;
do
{
sn = sn.Parent;
} while (sn != null && !(sn is procedure_definition));
procedure_definition pd = sn as procedure_definition;
if (sn == null)
{
// этого не будет
}
var fh = pd.proc_header as function_header;
if (fh == null)
{
// этого тоже не будет
}
var sq = fh.return_type as sequence_type;
if (sq == null)
{
// и этого не будет
}
var lst = new List<statement>();
var newid = new ident(CreateNameForLambdaInYield(), yn.ex.source_context);
var vs = new var_statement(newid, sq.elements_type, yn.ex);
vs.source_context = yn.ex.source_context;
var newyn = new yield_node(newid, newid.source_context);
lst.Add(vs);
lst.Add(newyn);
ReplaceStatementUsingParent(yn, lst);
}
}
}
}

View file

@ -1,60 +0,0 @@
// 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;
using System.Collections.Generic;
using System.Linq;
using System.Text;
using System.Threading.Tasks;
using PascalABCCompiler;
using PascalABCCompiler.SyntaxTree;
namespace SyntaxVisitors
{
public class IsVarRenameVisitor : BaseChangeVisitor
{
public IsVarRenameVisitor()
{
}
public static IsVarRenameVisitor New
{
get { return new IsVarRenameVisitor(); }
}
public static void Accept(procedure_definition pd)
{
New.ProcessNode(pd);
}
public override void visit(procedure_header proc_header)
{
// DO THIS THING!
}
/* public override void visit(desugared_deconstruction dd)
{
var l = new List<statement>();
l.Add(dd);
foreach (var d in dd.variables.definitions)
{
foreach (var id in d.vars.idents)
{
// добавить после неё кучу объявлений с присваиваниями
//ReplaceStatement(dd,)
var newvar = new ident(NewVariableName(id.name),id.source_context);
var vs = new var_statement(new ident(id.name, id.source_context), newvar, id.source_context);
l.Add(vs);
id.name = newvar.name;
}
}
ReplaceStatement(dd, l);
}*/
private string NewVariableName(string name)
{
name = name.ToLower();
return "$RenIsVarYield$" + name;
}
}
}

View file

@ -971,10 +971,9 @@ namespace SyntaxVisitors
pd.visit(checkVarRedefVisitor); pd.visit(checkVarRedefVisitor);
*/ */
// Если есть в pd узлы is_pattern_expr, то запустить визитор, добавляющий присваивание временной переменной и заменяющий
// везде далее имя исходной переменной на имя временной // SSM 21/06 - Выносим yield x -> x
// SSM 20/06 - не очень так получается. Сложно CapturedLambdaInYieldVisitor.Accept(pd);
//IsVarRenameVisitor.Accept(pd);
// Выносим выражение из yield в отдельную переменную // Выносим выражение из yield в отдельную переменную
ReplaceYieldExprByVarVisitor.Accept(pd); ReplaceYieldExprByVarVisitor.Accept(pd);

View file

@ -0,0 +1,190 @@
// BBC Micro:bit communication module
unit BBCMicrobit;
interface
/// Исключение для информирования об отсутствии подключенного устройства
type
NoUBSComPortsException = class(Exception) end;
NoBBCBoardFoundException = class(Exception) end;
/// Класс для взаимодействия с устройством BBC Micro:bit
type
Microbit = class(System.IDisposable)
protected
/// Порт для связи с устройством
Port: System.IO.Ports.SerialPort;
/// Обработчик данных от платы. Принимает только строки
procedure DataReceivedHandler(sender: object; e: System.IO.Ports.SerialDataReceivedEventArgs);
public
/// Копирование файла прошивки в BBC:Microbit
class procedure CopyFile(filename : string);
public
/// Обработчик события распознавания
OnReadString: procedure(Message: string);
/// Список USB COM-портов с идентификаторами Microbit
class function GetUsbPortNames: List<string>;
begin
// Вот такие параметры у каждой платы (по крайней мере сейчас)
var pattern := '^VID_0D28.PID_0204';
var _rx := new System.Text.RegularExpressions.Regex(pattern, RegexOptions.IgnoreCase);
Result := new List<string>;
var {Microsoft.Win32.RegistryKey} rk1 := Microsoft.Win32.Registry.LocalMachine;
var {Microsoft.Win32.RegistryKey} rk2 := rk1.OpenSubKey('SYSTEM\\CurrentControlSet\\Enum');
foreach s3: string in rk2.GetSubKeyNames do
begin
var rk3 := rk2.OpenSubKey(s3);
foreach s: string in rk3.GetSubKeyNames do
if _rx.Match(s).Success then
begin
var {RegistryKey} rk4 := rk3.OpenSubKey(s);
foreach s2: string in rk4.GetSubKeyNames do
begin
var {RegistryKey} rk5 := rk4.OpenSubKey(s2);
var {RegistryKey} rk6 := rk5.OpenSubKey('Device Parameters');
var {string} portName := string(rk6.GetValue('PortName'));
if not String.IsNullOrEmpty(portName) and System.IO.Ports.SerialPort.GetPortNames.Contains(portName) then
begin
Result.Add(string(rk6.GetValue('PortName')));
end;
end;
end;
end;
end;
/// <summary>
/// Конструктор объекта для взаимодействия с Microbit
/// </summary>
/// <param name="Handler">Процедура-обработчик, вызываемая для каждой принятой строки</param>
/// <param name="PortName">Имя COM-порта, можно не указывать</param>
constructor Create(Handler: procedure(s: string) := nil; PortName: string := '');
begin
OnReadString := Handler;
// Инициализируем виртуальный COM-порт, который связан с USB-устройством.
Port := new System.IO.Ports.SerialPort;
if PortName.Length > 0 then
// Порт указан явно при создании объекта класса, значит его и используем
Port.PortName := PortName
else
begin
// Порт явно не указан, приходится искать самостоятельно
// Получаем список всех похожих COM-портов (по VID и PID)
var portNames := GetUsbPortNames;
// Если подходящих портов нет - выбрасываем исключение
if portNames.Count = 0 then
raise new NoUBSComPortsException('Не найдено устройство Microbit')
else
// Берём первый попавшийся. Если устройств несколько, то надо явно указывать
Port.PortName := portNames[0];
end;
// Эти параметры зашиты явно, рекомендованы руководством по Microbit
Port.BaudRate := 115200; //Указываем скорость.
Port.DataBits := 8;
Port.Parity := System.IO.Ports.Parity.None;
Port.StopBits := System.IO.Ports.StopBits.One;
Port.DataReceived += DataReceivedHandler;
Port.Open; //Открываем порт
end;
/// Отправка строки на устройство Microbit
procedure Send(message: string) := Port.WriteLine(message);
/// Деструктор - закрывает COM-порт
destructor Destroy;
begin
if Port <> nil then
begin
Port.Close;
Port := nil;
end;
end;
procedure Dispose;
begin
Destroy;
end;
procedure Finalize; override;
begin
Destroy
end;
end;
implementation
/// Иногда строки приходят "склеенные" – нужно разбить по служебным символам
/// Эта функция возвращает первую группу символов из строки, ограниченную
/// служебными #10 или #13, сама подстрока из строки удаляется.
function ParseStr(var s : string) : string;
begin
var iStart := 1;
var len := s.Length;
while (iStart<=len) and ((s[iStart] = #10) or (s[iStart] = #13)) do
iStart += 1;
var iEnd := iStart + 1;
while (iEnd<=len) and (s[iEnd] <> #10) and (s[iEnd] <> #13) do
iEnd += 1;
// Копируем фрагмент, но с проверкой
if iEnd-iStart > 0 then
Result := copy(s, iStart, iEnd-iStart)
else
Result := '';
while (iEnd<len) and ((s[iEnd+1] = #10) or (s[iEnd+1] = #13)) do
iEnd += 1;
Delete(s,1,iEnd);
end;
procedure Microbit.DataReceivedHandler(sender: object; e: System.IO.Ports.SerialDataReceivedEventArgs);
begin
var sp := sender as System.IO.Ports.SerialPort;
// Читаем строку по ReadLine
var message := sp.ReadLine;
while message.Length > 0 do
begin
// Очередная подстрока
var block := ParseStr(message).TrimEnd(' ');
if (block.Length > 0) and (OnReadString <> nil) then
OnReadString(block);
end;
end;
class procedure MicroBit.CopyFile(filename : string);
begin
var allDrives := System.IO.DriveInfo.GetDrives();
foreach d: System.IO.DriveInfo in allDrives do
begin
if d.IsReady then
if d.VolumeLabel = 'MICROBIT' then
begin
var dest : string := d.RootDirectory.ToString + '\\' + System.IO.Path.GetFileName(filename);
System.IO.File.Copy(filename, dest);
sleep(2000);
exit;
end;
end;
raise new NoBBCBoardFoundException('Не найдено устройство Microbit');
end;
end.

View file

@ -0,0 +1,91 @@
unit SF;
procedure Pr(params a: array of object) := Print(a);
procedure Pr(o: object) := Print(o);
procedure Pr(s: string) := Print(s);
procedure Prln(params a: array of object) := Println(a);
function RI := ReadInteger;
function RBI := ReadBigInteger;
function RI64 := ReadInt64;
function RR := ReadReal;
function RC := ReadChar;
function RS := ReadString;
function RlnI := ReadlnInteger;
function RlnBI := ReadlnBigInteger;
function RlnI64 := ReadlnInt64;
function RlnR := ReadlnReal;
function RlnC := ReadlnChar;
function RlnS := ReadlnString;
function RI2 := ReadInteger2;
function RR2 := ReadReal2;
function RC2 := ReadChar2;
function RS2 := ReadString2;
function RlnI2 := ReadlnInteger2;
function RlnR2 := ReadlnReal2;
function RlnC2 := ReadlnChar2;
function RlnS2 := ReadlnString2;
function RI3 := ReadInteger3;
function RR3 := ReadReal3;
function RC3 := ReadChar3;
function RS3 := ReadString3;
function RlnI3 := ReadInteger3;
function RlnR3 := ReadlnReal3;
function RlnC3 := ReadlnChar3;
function RlnS3 := ReadlnString3;
function RAI(n: integer) := ReadArrInteger(n);
function RAR(n: integer) := ReadArrReal(n);
function Pr(Self: integer): integer; extensionmethod := Self.Print;
function Pr(Self: real): real; extensionmethod := Self.Print;
function Pr(Self: Biginteger): Biginteger; extensionmethod := Self.Print;
function Pr(Self: char): char; extensionmethod := Self.Print;
function Pr(Self: boolean): boolean; extensionmethod := Self.Print;
function Pr(Self: string): string; extensionmethod := Self.Print;
function Prln(Self: integer): integer; extensionmethod := Self.Println;
function Prln(Self: real): real; extensionmethod := Self.Println;
function Prln(Self: Biginteger): Biginteger; extensionmethod := Self.Println;
function Prln(Self: char): char; extensionmethod := Self.Println;
function Prln(Self: boolean): boolean; extensionmethod := Self.Println;
function Prln(Self: string): string; extensionmethod := Self.Println;
procedure ReMin(var min: integer; x: integer);
begin
if x < min then
min := x
end;
procedure ReMax(var max: integer; x: integer);
begin
if x > max then
max := x
end;
procedure ReMin(var min: real; x: real);
begin
if x < min then
min := x
end;
procedure ReMax(var max: real; x: real);
begin
if x > max then
max := x
end;
function ToI(Self: string); extensionmethod := Self.ToInteger;
function ToR(Self: string); extensionmethod := Self.ToReal;
function operator-(c,c1: char): integer; extensionmethod := Ord(c) - Ord(c1);
function Len(Self: string): integer; extensionmethod := Self.Length;
end.

View file

@ -0,0 +1,538 @@
unit School;
interface
/// Перевод десятичного числа в двоичную систему счисления
function Bin(x: int64): string;
/// Перевод десятичного числа в двоичную систему счисления
function Bin(x: BigInteger): string;
/// Перевод десятичного числа в восьмеричную систему счисления
function Oct(x: int64): string;
/// Перевод десятичного числа в восьмеричную систему счисления
function Oct(x: BigInteger): string;
/// Перевод десятичного числа в шестнадцатиричную систему счисления
function Hex(x: int64): string;
/// Перевод десятичного числа в шестнадцатиричную систему счисления
function Hex(x: BigInteger): string;
/// Перевод из системы по основанию base [2..36] в десятичную
function Dec(s: string; base: integer): int64;
/// Перевод из системы по основанию base [2..36] в десятичную
function DecBig(s: string; base: integer): BigInteger;
/// Возвращает кортеж из минимума и максимума последовательности s
function MinMax(s: sequence of int64): (int64, int64);
/// Возвращает кортеж из минимума и максимума последовательности s
function MinMax(s: sequence of integer): (integer, integer);
/// Ввозвращает НОД и НОК пары чисел
function НОДНОК(a, b: int64): (int64, int64);
/// Разложение числа на простые множители
function Factorize(n: int64): List<int64>;
/// Рразложение числа на простые множители
function Factorize(n: integer): List<integer>;
/// Простые числа на интервале [2;n]
function Primes(n: integer): List<integer>;
/// Первые n простых чисел
function FirstPrimes(n: integer): List<integer>;
/// Возвращает массив, содержащий цифры числа
function Digits(n: int64): List<integer>;
/// возвращает список делителей натурального числа
function Divizors(n: int64): List<int64>;
/// возвращает список делителей натурального числа
function Divizors(n: integer): List<integer>;
/// Возвращает Sin угла, заданного в градусах
function SinDegrees(x: real): real;
/// Возвращает Cos угла, заданного в градусах
function CosDegrees(x: real): real;
/// Возвращает вещественный массив, заполненный случайными значениями
/// на интервале [a; b) с t знаками в дробной части
function ArrRandomReal(n: integer; a, b: real; t: integer): array of real;
/// Возвращает вещественную последовательность, заполненную случайными значениями
/// на интервале [a; b) с t знаками в дробной части
function SeqRandomReal(n: integer; a, b: real; t: integer): sequence of real;
/// Возвращает вещественную матрицу, заполненную случайными значениями
/// на интервале [a; b) с t знаками в дробной части
function MatrRandomReal(m: integer; n: integer; a, b: real; t: integer): array [,] of real;
implementation
type
School_BadCharInString = class(Exception)
end;
School_InvalidBase = class(Exception)
end;
{$region Bin}
function Bin(x: int64): string;
begin
x := Abs(x);
var r := '';
while x >= 2 do
(r, x) := (x mod 2 + r, x Shr 1);
Result := x + r
end;
function Bin(x: BigInteger): string;
begin
x := Abs(x);
var r := '';
while x >= 2 do
(r, x) := (byte(x mod 2) + r, x div 2);
Result := byte(x) + r
end;
{$endregion}
{$region Oct}
function Oct(x: int64): string;
begin
x := Abs(x);
var r := '';
while x >= 8 do
(r, x) := (x mod 8 + r, x Shr 3);
Result := x + r
end;
function Oct(x: BigInteger): string;
begin
x := Abs(x);
var r := '';
while x >= 8 do
(r, x) := (byte(x mod 8) + r, x div 8);
Result := byte(x) + r
end;
{$endregion}
{$region Hex}
function Hex(x: int64): string;
begin
x := Abs(x);
var s := '0123456789ABCDEF';
var r := '';
while x >= 16 do
(r, x) := (s[x mod 16 + 1] + r, x Shr 4);
Result := s[x + 1] + r
end;
function Hex(x: BigInteger): string;
begin
x := Abs(x);
var s := '0123456789ABCDEF';
var r := '';
while x >= 16 do
(r, x) := (s[byte(x mod 16) + 1] + r, x div 16);
Result := s[byte(x) + 1] + r
end;
{$endregion}
{$region Dec}
function Dec(s: string; base: integer): int64;
begin
if not (base in 2..36) then
raise new School_InvalidBase
($'ToDecimal: Недопустимое основание {base}');
var sb := '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
s := s.ToUpper;
var r := s.Except(sb[:base + 1]).JoinToString;
if r.Length > 0 then
raise new School_BadCharInString
($'ToDecimal: Недопустимый символ "{r}" в строке {s}');
var (pa, p) := (BigInteger.One, BigInteger.Zero);
foreach var c in s.Reverse do
begin
var i := Pos(c, sb) - 1;
p += pa * i;
pa *= base
end;
Result := int64(p)
end;
function DecBig(s: string; base: integer): BigInteger;
begin
if not (base in 2..36) then
raise new School_InvalidBase
($'ToDecimal: Недопустимое основание {base}');
var sb := '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
s := s.ToUpper;
var r := s.Except(sb[:base + 1]).JoinToString;
if r.Length > 0 then
raise new School_BadCharInString
($'ToDecimal: Недопустимый символ "{r}" в строке {s}');
var pa := BigInteger.One;
Result := BigInteger.Zero;
foreach var c in s.Reverse do
begin
var i := Pos(c, sb) - 1;
Result += pa * i;
pa *= base
end
end;
{$endregion}
{$region MinMax}
/// Возвращает кортеж из минимума и максимума последовательности s
function MinMax(s: sequence of int64): (int64, int64);
begin
var (min, max) := (int64.MaxValue, int64.MinValue);
foreach var m in s do
if m < min then
min := m
else if m > max then
max := m;
Result := (min, max)
end;
/// Возвращает кортеж из минимума и максимума последовательности s
function MinMax(s: sequence of integer): (integer, integer);
begin
var (min, max) := (integer.MaxValue, integer.MinValue);
foreach var m in s do
if m < min then
min := m
else if m > max then
max := m;
Result := (min, max)
end;
/// Возвращает кортеж из минимума и максимума последовательности
function MinMax(Self: sequence of int64): (int64, int64); extensionmethod :=
MinMax(Self);
/// Возвращает кортеж из минимума и максимума последовательности
function MinMax(Self: sequence of integer): (integer, integer);
extensionmethod := MinMax(Self);
{$endregion}
{$region НОДНОК}
/// Возвращает НОД и НОК пары чисел
function НОДНОК(a, b: int64): (int64, int64);
begin
(a, b) := (Abs(a), Abs(b));
var (a1, b1) := (a, b);
while b <> 0 do
(a, b) := (b, a mod b);
Result := (a, a1 div a * b1)
end;
{$endregion}
{$region Factorize}
/// Разложение числа на простые множители
function Factorize(n: int64): List<int64>;
begin
n := Abs(n);
var i: int64 := 2;
var L := new List<int64>;
while i * i <= n do
if n mod i = 0 then
begin
L.Add(i);
n := n div i;
if n < i then
break
end
else
i += i = 2 ? 1 : 2;
if n > 1 then
L.Add(n);
Result := L
end;
/// Разложение числа на простые множители
function Factorize(n: integer): List<integer>;
begin
n := Abs(n);
var i := 2;
var L := new List<integer>;
while i * i <= n do
if n mod i = 0 then
begin
L.Add(i);
n := n div i;
if n < i then
break
end
else
i += i = 2 ? 1 : 2;
if n > 1 then
L.Add(n);
Result := L
end;
/// разложение числа на простые множители
function Factorize(Self: int64): List<int64>; extensionmethod :=
Factorize(Self);
/// Разложение числа на простые множители
function Factorize(Self: integer): List<integer>; extensionmethod :=
Factorize(Self);
{$endregion}
{$region Primes}
/// Простые числа на интервале [2;n]
function Primes(n: integer): List<integer>;
// Модифицированное решето Эратосфена на [2;n]
begin
var Mas := ArrFill(n, True);
var i := 2;
while i * i <= n do
begin
if Mas[i-1] then
begin
var k := i*i;
while k <= n do
begin
Mas[k-1] := False;
k += i
end
end;
Inc(i)
end;
n := Mas.Count(t -> t);
Result := new List<integer>;
for var j := 1 to Mas.High do
if Mas[j] then Result.Add(j + 1)
end;
/// Первые n простых чисел
function FirstPrimes(n: integer): List<integer>;
// Модифицированное решето Эратосфена
begin
var n1 := Trunc(Exp((Ln(n)+1.088)/0.8832));
var Mas := ArrFill(n1, True);
var i := 2;
while i * i <= n1 do
begin
if Mas[i-1] then
begin
var k := i*i;
while k <= n1 do
begin
Mas[k-1] := False;
k += i
end
end;
Inc(i)
end;
//n := Mas.Count(t -> t);
Result := new List<integer>;
i := 0;
for var j := 1 to Mas.High do
if Mas[j] then
begin
Result.Add(j + 1);
Inc(i);
if i = n then break
end
end;
/// возвращает True, если число простое и False в противном случае
function IsPrime(Self: integer): boolean; extensionmethod;
begin
if Self < 2 then
begin
Result := False;
exit
end;
var i := 2;
while i * i <= Self do
if Self mod i = 0 then
begin
Result := False;
exit
end
else
i += if i = 2 then 1 else 2;
Result := True
end;
/// возвращает True, если число простое и False в противном случае
function IsPrime(Self: int64): boolean; extensionmethod;
begin
if Self < 2 then
begin
Result := False;
exit
end;
var i := int64(2);
while i * i <= Self do
if Self mod i = 0 then
begin
Result := False;
exit
end
else
i += if i = 2 then 1 else 2;
Result := True
end;
{$endregion}
{$region Digits}
/// Возвращает массив, содержащий цифры числа
function Digits(n: int64): List<integer>;
begin
var St := new Stack<integer>;
n := Abs(n);
if n = 0 then Result.Add(0)
else
begin
while n > 0 do
begin
St.Push(n mod 10);
n := n div 10
end;
Result := St.ToList
end
end;
/// Возвращает массив, содержащий цифры числа
function Digits(Self: integer): List<integer>;
extensionmethod := Digits(Self);
/// возвращает массив, содержащий цифры числа
function Digits(Self: int64): List<integer>;
extensionmethod := Digits(Self);
{$endregion}
{$region Divisors}
/// возвращает список всех делителей натурального числа
function Divizors(n: integer): List<integer>;
begin
n := Abs(n); // foolproof
var L := new List<integer>;
L.Add(1);
L.Add(n);
if n > 3 then
begin
var k := 2;
while (k * k <= n) and (k < 46341) do
begin
if n mod k = 0 then
begin
var t := n div k;
L.Add(k);
if k < t then L.Add(t)
else break
end;
Inc(k)
end;
L.Sort;
end;
Result := L
end;
/// возвращает список всех делителей натурального числа
function Divizors(n: int64): List<int64>;
begin
n := Abs(n); // foolproof
var L := new List<int64>;
L.Add(1);
L.Add(n);
if n > 3 then
begin
var k := int64(2);
while (k * k <= n) and (k < 3037000500) do
begin
if n mod k = 0 then
begin
var t := n div k;
L.Add(k);
if k < t then L.Add(t)
else break
end;
Inc(k)
end;
L.Sort;
end;
Result := L
end;
/// возвращает список делителей натурального числа
function Divizors(Self: integer): List<integer>; extensionmethod :=
Divizors(Self);
/// возвращает список делителей натурального числа
function Divizors(Self: int64): List<int64>; extensionmethod :=
Divizors(Self);
{$endregion}
{$region Trig}
function SinDegrees(x: real): real := Sin(DegToRad(x));
function CosDegrees(x: real): real := Cos(DegToRad(x));
function TanDegrees(x: real): real := Tan(DegToRad(x));
{$endregion}
{$region Random}
/// Возвращает вещественный массив, заполненный случайными значениями
/// на интервале [a; b) с t знаками в дробной части
function ArrRandomReal(n: integer; a, b: real; t: integer): array of real;
begin
Result := new real[n];
for var i := 0 to Result.Length - 1 do
Result[i] := Round(Random * (b - a) + a, t);
end;
/// Возвращает вещественную последовательность, заполненную случайными значениями
/// на интервале [a; b) с t знаками в дробной части
function SeqRandomReal(n: integer; a, b: real; t: integer): sequence of real;
begin
loop n do
yield Round(Random * (b - a) + a, t)
end;
/// Возвращает вещественную матрицу, заполненную случайными значениями
/// на интервале [a; b) с t знаками в дробной части
function MatrRandomReal(m: integer; n: integer; a, b: real; t: integer): array [,] of real;
begin
Result := new real[m, n];
for var i := 0 to Result.RowCount - 1 do
for var j := 0 to Result.ColCount - 1 do
Result[i, j] := Round(Random * (b - a) + a, t);
end;
{$endregion}
end.

File diff suppressed because it is too large Load diff

9
TestSuite/lam_yield.pas Normal file
View file

@ -0,0 +1,9 @@
function f1: sequence of byte->byte;
begin
yield b->b*b;
end;
begin
var q := f1().First;
Assert(q(2)=4);
end.

View file

@ -0,0 +1,3 @@
uses u1 in 'UsesInUnits\u1.pas';
begin end.

View file

@ -0,0 +1,3 @@
uses u0 in 'UsesInUnits2\u0.pas';
begin end.

14
TestSuite/where12.pas Normal file
View file

@ -0,0 +1,14 @@
type
t1<T> = class
where T: record;
end;
t2<T> = class(t1<T>)
where T: record, constructor;
end;
begin
Assert(1=1)
end.

View file

@ -1,7 +1,7 @@
// Syntax tree conversion errors // Syntax tree conversion errors
%PREFIX%=SYNTAXTREEVISITORSERROR_ %PREFIX%=SYNTAXTREEVISITORSERROR_
YIELD_FUNC_MUST_RETURN_SEQUENCE=Функции с yield должны непосредственно возвращать тип sequence of T или IEnumerable<T> YIELD_FUNC_MUST_RETURN_SEQUENCE=Функции с yield должны иметь тип возвращаемого значения sequence of T или IEnumerable<T>
YIELD_FUNC_CANNOT_RETURN_SEQUENCE_OF_ANONYMOUS_DELEGATES=Функции с yield не могут возвращать последовательность анонимных делегатов YIELD_FUNC_CANNOT_RETURN_SEQUENCE_OF_ANONYMOUS_DELEGATES=Функции с yield не могут возвращать последовательность анонимных делегатов
ONLY_FUNCTIONS_CAN_CONTAIN_YIELDS=Только функции могут содержать yield ONLY_FUNCTIONS_CAN_CONTAIN_YIELDS=Только функции могут содержать yield
FUNCTIONS_WITH_YIELDS_CANNOT_CONTAIN_VAR_CONST_PARAMS_MODIFIERS=В параметрах функции с yield не должно быть модификаторов 'var' или 'const' FUNCTIONS_WITH_YIELDS_CANNOT_CONTAIN_VAR_CONST_PARAMS_MODIFIERS=В параметрах функции с yield не должно быть модификаторов 'var' или 'const'