administrator/pascalabcnet
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

[Cache] может работать с exit и использует d.TryGetValue

Browse source
This commit is contained in:
Mikhalkovich Stanislav 2021-08-28 23:15:33 +03:00
parent edcb611778
commit ecf7ef3663
20 changed files with 131 additions and 60 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
Configuration/GlobalAssemblyInfo.cs
View file

@ -14,8 +14,8 @@ internal static class RevisionClass
{
public const string Major = "3";
public const string Minor = "8";
public const string Build = "0";
public const string Revision = "2966";
public const string Build = "1";
public const string Revision = "2975";
public const string MainVersion = Major + "." + Minor;
public const string FullVersion = Major + "." + Minor + "." + Build + "." + Revision;

4
Configuration/Version.defs
View file

@ -1,4 +1,4 @@
%COREVERSION%=0
%REVISION%=2966
%MINOR%=8
%REVISION%=2975
%COREVERSION%=1
%MAJOR%=3

BIN
Localization/DefaultLang.resources
View file

Binary file not shown.

43
PABCNetHelp/LangGuide/CompilerDirectives/index_directives.html
View file

@ -45,6 +45,28 @@
<p><b>{$apptype &lt;тип приложения&gt;}</b> - задание типа приложения
(windows/console). </p>
<p><b>{$reference &lt;имя файла&gt;}</b> - подключение библиотеки. </p>
<p><b>{$include &lt;имя файла&gt;}</b> - включение в текст программы содержимого
указанного файла. </p>
<p><b>{$define &lt;идентификатор&gt;}</b> - определение имени, используемого в
директивах <b>$ifdef</b>, <b>$ifndef</b>. </p>
<p><b>{$undef &lt;идентификатор&gt;}</b> - исключение имени, используется для отмены
действия директивы <b>$define</b>. </p>
<p><b>{$ifdef &lt;идентификатор&gt;}</b> - начало блока условной компиляции
(проверяется условие: &quot;идентификатор определен&quot;). </p>
<p><b>{$ifndef &lt;идентификатор&gt;}</b> - начало блока условной компиляции
(проверяется условие: &quot;идентификатор не определен&quot;). </p>
<p><b>{$else}</b> - директива &quot;иначе&quot; в блоке условной компиляции. </p>
<p><b>{$endif}</b> - завершение блока условной компиляции. </p>
<p><b>{$faststrings}</b> - строки с быстрым доступом к символам на запись, но со
ссылочной семантикой. </p>
<p><b>{$zerobasedstrings}</b> - включение строк, индексируемых с 0.</p>
<p><b>{$zerobasedstrings on}</b> - включение строк, индексируемых с 0.</p>
<p><b>{$zerobasedstrings off}</b> - выключение строк, индексируемых с 0.</p>
<p><strong>{$</strong><span class="highlight-strong"><strong>platformtarget</strong></span><strong>
x86}</strong> - компиляция для 32-битной платформы (требуется для подключения
32-битных dll)</p>
<p><strong>{$</strong><span class="highlight-strong"><strong>platformtarget</strong></span><strong>
x64}</strong> - компиляция для 64-битной платформы</p>
<p><b>{$gendoc &lt;параметр&gt;}</b> -генерация документации в XML формате. Параметры:
<b>true</b>, <b>false</b>. </p>
<p><b>{$mainresource &lt;имя файла&gt;}</b> - подключение .res файла в качестве
@ -62,27 +84,6 @@
<p><b>{$company &lt;компания&gt;}</b> - компания </p>
<p><b>{$copyright &lt;копирайт&gt;}</b> - копирайт </p>
<p><b>{$trademark &lt;торговая марка&gt;}</b> - торговая марка </p>
<p><b>{$include &lt;имя файла&gt;}</b> - включение в текст программы содержимого
указанного файла. </p>
<p><b>{$define &lt;идентификатор&gt;}</b> - определение имени, используемого в
директивах <b>$ifdef</b>, <b>$ifndef</b>. </p>
<p><b>{$undef &lt;идентификатор&gt;}</b> - исключение имени, используется для отмены
действия директивы <b>$define</b>. </p>
<p><b>{$ifdef &lt;идентификатор&gt;}</b> - начало блока условной компиляции
(проверяется условие: &quot;идентификатор определен&quot;). </p>
<p><b>{$ifndef &lt;идентификатор&gt;}</b> - начало блока условной компиляции
(проверяется условие: &quot;идентификатор не определен&quot;). </p>
<p><b>{$else}</b> - директива &quot;иначе&quot; в блоке условной компиляции. </p>
<p><b>{$endif}</b> - завершение блока условной компиляции. </p>
<p><b>{$faststrings}</b> - строки с быстрым доступом к символам на запись, но со
ссылочной семантикой. </p>
<p><b>{$string_nullbased+}</b> - включение строк, индексируемых с 0.</p>
<p><b>{$string_nullbased-}</b> - выключение строк, индексируемых с 0.</p>
<p><strong>{$</strong><span class="highlight-strong"><strong>platformtarget</strong></span><strong>
x86}</strong> - компиляция для 32-битной платформы (требуется для подключения
32-битных dll)</p>
<p><strong>{$</strong><span class="highlight-strong"><strong>platformtarget</strong></span><strong>
x64}</strong> - компиляция для 64-битной платформы</p>
<p>Директивы <b>$ifdef</b>, <b>$ifndef</b> совместно с директивами <b>$else</b>
и <b>$endif</b> управлют условной компиляцией частей исходного файла. Каждой
директиве <b>$ifdef</b>, <b>$ifndef</b> должна соответствовать завершающая ее

2
Release/pabcversion.txt
View file

@ -1 +1 @@
3.8.0.2966
3.8.1.2975

2
ReleaseGenerators/PascalABCNET_version.nsh
View file

@ -1 +1 @@
!define VERSION '3.8.0.2966'
!define VERSION '3.8.1.2975'

50
SyntaxVisitors/SugarVisitors/CacheFunctionVisitor.cs
View file

@ -19,6 +19,11 @@ namespace SyntaxVisitors.SugarVisitors
{
get { return new CacheFunctionVisitor(); }
}
public override void visit(simple_attribute_list al)
{
base.visit(al);
}
public override void visit(procedure_definition pd)
{
var attrs = pd.proc_header.attributes;
@ -36,7 +41,7 @@ namespace SyntaxVisitors.SugarVisitors
//if (attrs?.attributes?[0].attributes?[0]?.type?.names?[0]?.name?.ToLower()=="cache") // слишком быстро
if (qq != null && qq.Any(nm=>nm.name.ToLower()=="cache"))
{
// проверить, что
// проверить, что
// это функция +
// это не метод расширения +
// параметры есть (хоть один) +
@ -46,15 +51,17 @@ namespace SyntaxVisitors.SugarVisitors
// отсутствие var и const в параметрах +
// функция определена глобально
if (pd.DescendantNodes().OfType<yield_node>().Count() > 0)
throw new SyntaxVisitorError("FUNCTIONS_WITH_CACHE_ATTRIBUTE_CANNOT_HAVE_YIELD", pd.proc_header);
var fh = pd.proc_header as function_header;
if (fh == null)
throw new SyntaxVisitorError("ONLY_FUNCTION_SHOULD_HAVE_CACHE_ATTRIBUTE",pd.proc_header);
var isExtension = fh.proc_attributes.proc_attributes.Any(attr => attr.name == "extensionmethod");
if (isExtension)
throw new SyntaxVisitorError("EXTENSION_FUNCTIONS_SHOULD_NOT_HAVE_CACHE_ATTRIBUTE", fh);
if (fh.parameters != null && fh.parameters.Count == 0)
if (fh.parameters == null || fh.parameters != null && fh.parameters.Count == 0)
throw new SyntaxVisitorError("FUNCTIONS_WITH_CACHE_ATTRIBUTE_SHOULD_HAVE_PARAMETERS", fh);
if (fh.parameters != null && fh.parameters.Count > 7)
if (fh.parameters != null && fh.parameters.params_list.Sum(tp => tp.idents.idents.Count) > 7)
throw new SyntaxVisitorError("FUNCTIONS_WITH_CACHE_ATTRIBUTE_SHOULD_HAVE_LESSTHEN8_PARAMETERS", fh);
if (fh.return_type == null)
throw new SyntaxVisitorError("FUNCTIONS_WITH_CACHE_ATTRIBUTE_SHOULD_HAVE_EXPLICIT_RETURN_TYPE", fh);
@ -74,7 +81,10 @@ namespace SyntaxVisitors.SugarVisitors
new expression_list(pp.Select(pair => pair.Item1 as expression).ToList())
)
);
(pd.proc_body as block).program_code.list.Insert(0, vs);
var proc_code = (pd.proc_body as block).program_code;
proc_code.list.Insert(0, vs);
if (proc_code.list[proc_code.list.Count - 1] is empty_statement)
proc_code.list.RemoveAt(proc_code.list.Count - 1);
// var @ИмяФункцииDict := new Dictionary<типTuple, тип возвр значения функции>
// var d := new PABCSystem.Dictionary<System.Tuple<integer,integer,real>,integer>;
@ -103,17 +113,39 @@ namespace SyntaxVisitors.SugarVisitors
// Result := d[tup];
// exit;
// end;
var indr = new indexer(dictIdent, new expression_list(tupleIdent));
// а надо другой код
/*var indr = new indexer(dictIdent, new expression_list(tupleIdent));
var assRes = new assign("Result", indr);
var exitst = new procedure_call(new ident("exit"));
var stlst = new statement_list(assRes, exitst);
var cond = new method_call(new dot_node(dictIdent, new ident("ContainsKey")),
new expression_list(tupleIdent));
var ifstatement = new if_node(cond, stlst);
(pd.proc_body as block).program_code.list.Insert(1, ifstatement);
// В конец: d[tup] := Result
var ifstatement = new if_node(cond, stlst);*/
// if d.TryGetValue(tup,Result) then exit;
var indr = new indexer(dictIdent, new expression_list(tupleIdent));
var exitst = new procedure_call(new ident("exit"));
var cond = new method_call(new dot_node(dictIdent, new ident("TryGetValue")),
new expression_list(new List<expression> { tupleIdent, new ident("Result") }));
var ifstatement = new if_node(cond, exitst);
proc_code.list.Insert(1, ifstatement);
// В конец: d[tup] := Result. И надо то же после каждого exit
var assEnd = new assign(indr, new ident("Result"));
(pd.proc_body as block).program_code.list.Add(assEnd);
// Вставить d[tup] := Result перед каждым exit начиная с конца
var pcc = pd.DescendantNodes().OfType<procedure_call>().Where(pc => pc.func_name is ident id && id.name.ToLower() == "exit" && pc.source_context != null).ToArray();
foreach (var p in pcc.Reverse())
{
var ae = assEnd.Clone() as assign;
if (p.Parent is statement_list sl)
sl.ReplaceInList(p, new List<statement> { ae, p});
else p.Parent.ReplaceDescendant(p as statement, new statement_list(new List<statement> { ae, p }));
}
if (proc_code.list[proc_code.list.Count - 1] is procedure_call pcall && pcall.func_name is ident idd && idd.name.ToLower() == "exit")
; // ничего не добавлять - т.к. перед exit всё добавлено
else proc_code.list.Add(assEnd);
// Добавить в начало функции семантические проверки:
// отсутствие делегатов и pointer в параметрах

19
TestSuite/Cache_exit_test.pas Normal file
View file

@ -0,0 +1,19 @@
[Cache]
function f1(q: byte): byte;
begin
var a := q;
Result := 1;
if a > 2 then
begin
Result := 2;
exit;
end;
//exit(5);
Result := 3;
a := 5;
exit;
end;
begin
Assert(f1(3)=f1(3));
end.

2
TestSuite/CompilationSamples/PABCExtensions.pas
View file

@ -3,7 +3,7 @@
///--
unit PABCExtensions;
{$string_nullbased-}
{$zerobasedstrings off}
uses PABCSystem;

6
TestSuite/CompilationSamples/PABCSystem.pas
View file

@ -5,7 +5,7 @@
/// !! System unit
unit PABCSystem;
{$string_nullbased-}
{$zerobasedstrings off}
{$gendoc true}
@ -12867,7 +12867,7 @@ end;
procedure PassSpaces(var s: string; var from: integer);
begin
while (from <= s.Length) and (s[from]=' ') do
while (from <= s.Length) and char.IsWhiteSpace(s[from]) do
from += 1;
end;
@ -13083,7 +13083,7 @@ end;
///--
function SystemSlice0(Self: string; situation: integer; from, &to: integer; step: integer := 1): string; extensionmethod;
begin
Result := SystemSliceStringImpl(Self, situation, from, &to, step, 0); // 0 - NullBased
Result := SystemSliceStringImpl(Self, situation, from, &to, step, 0); // 0 - ZeroBased
end;
///--

2
TestSuite/slice_string_nullbased.pas
View file

@ -1,4 +1,4 @@
{$string_nullbased+}
{$zerobasedstrings}
uses PABCExtensions;

2
TreeConverter/TreeConversion/SemanticRules.cs
View file

@ -30,7 +30,7 @@ namespace PascalABCCompiler.TreeConverter
/// <summary>
/// Индексировать строки с 0
/// </summary>
public static bool NullBasedStrings = false;
public static bool ZeroBasedStrings = false;
/// <summary>
/// Строгая проверка типа указателя

4
TreeConverter/TreeConversion/SyntaxTreeToSemanticTreeConverter.cs
View file

@ -40,7 +40,7 @@ namespace PascalABCCompiler.TreeConverter
{
case PascalABCCompiler.SyntaxTree.LanguageId.PascalABCNET:
SemanticRules.AddResultVariable = true;
SemanticRules.NullBasedStrings = false;
SemanticRules.ZeroBasedStrings = false;
SemanticRules.FastStrings = false;
SemanticRules.InitStringAsEmptyString = true;
SemanticRules.UseDivisionAssignmentOperatorsForIntegerTypes = false;
@ -55,7 +55,7 @@ namespace PascalABCCompiler.TreeConverter
break;
case PascalABCCompiler.SyntaxTree.LanguageId.C:
SemanticRules.AddResultVariable = false;
SemanticRules.NullBasedStrings = true;
SemanticRules.ZeroBasedStrings = true;
SemanticRules.InitStringAsEmptyString = false;
SemanticRules.UseDivisionAssignmentOperatorsForIntegerTypes = true;
SemanticRules.ManyVariablesOneInitializator = false;

8
TreeConverter/TreeConversion/compiler_string_consts.cs
View file

@ -322,9 +322,11 @@ namespace PascalABCCompiler.TreeConverter
public static string compiler_directive_reference = "reference";
public static string include_namespace_directive = "includenamespace";
public static string compiler_savepcu = "savepcu";
public static string compiler_directive_nullbasedstrings = "nullbasedstrings";
public static string compiler_directive_nullbasedstrings_ON = "string_nullbased+";
public static string compiler_directive_nullbasedstrings_OFF = "string_nullbased-";
public static string compiler_directive_zerobasedstrings = "zerobasedstrings";
public static string compiler_directive_zerobasedstrings_ON = "string_zerobased+";
public static string compiler_directive_zerobasedstrings_OFF = "string_zerobased-";
public static string compiler_directive_nullbasedstrings_ON = "string_nullbased+"; // для совместимости. Deprecated
public static string compiler_directive_nullbasedstrings_OFF = "string_nullbased-"; // для совместимости. Deprecated
public static string compiler_directive_initstring_as_empty_ON = "string_initempty+";
public static string compiler_directive_initstring_as_empty_OFF = "string_initempty-";
public static string compiler_directive_resource = "resource";

29
TreeConverter/TreeConversion/syntax_tree_visitor.cs
View file

@ -5404,9 +5404,9 @@ namespace PascalABCCompiler.TreeConverter
bool has_extension_overload = false;
semantic_node sn = convert_semantic_strong(_dot_node.left);
// SSM 17/07/21 учёт NullBasedStrings в семантике срезов строк
// SSM 17/07/21 учёт ZeroBasedStrings в семантике срезов строк
// Пока не получилось
if (SemanticRules.NullBasedStrings
if (SemanticRules.ZeroBasedStrings
&& (sn as expression_node)?.type is compiled_type_node ctn && ctn.compiled_type == typeof(string)
&& _dot_node.right is ident id0
)
@ -16202,7 +16202,7 @@ namespace PascalABCCompiler.TreeConverter
//String 1 based
if (parameters.expressions.Count == 1 &&
nspr.property.comprehensive_type == SystemLibrary.SystemLibrary.string_type &&
!SemanticRules.NullBasedStrings && (lbvr == null || !lbvr.var.name.StartsWith("<>match")))
!SemanticRules.ZeroBasedStrings && (lbvr == null || !lbvr.var.name.StartsWith("<>match")))
{
nspr.fact_parametres.AddElement(
ConstructDecExpr(
@ -19420,19 +19420,34 @@ namespace PascalABCCompiler.TreeConverter
SemanticRules.FastStrings = true;
return;
}
if (node.Name.text.ToLower() == compiler_string_consts.compiler_directive_nullbasedstrings)
if (node.Name.text.ToLower() == compiler_string_consts.compiler_directive_zerobasedstrings)
{
SemanticRules.NullBasedStrings = node.Directive.text.ToLower() == compiler_string_consts.true_const_name;
var paramOnOff = node.Directive.text.ToLower();
if (paramOnOff == "on" || paramOnOff == "")
SemanticRules.ZeroBasedStrings = true;
else if (paramOnOff == "off")
SemanticRules.ZeroBasedStrings = false;
//SemanticRules.ZeroBasedStrings = node.Directive.text.ToLower() == compiler_string_consts.true_const_name;
return;
}
if (node.Name.text.ToLower() == compiler_string_consts.compiler_directive_zerobasedstrings_ON)
{
SemanticRules.ZeroBasedStrings = true;
return;
}
if (node.Name.text.ToLower() == compiler_string_consts.compiler_directive_zerobasedstrings_OFF)
{
SemanticRules.ZeroBasedStrings = false;
return;
}
if (node.Name.text.ToLower() == compiler_string_consts.compiler_directive_nullbasedstrings_ON)
{
SemanticRules.NullBasedStrings = true;
SemanticRules.ZeroBasedStrings = true;
return;
}
if (node.Name.text.ToLower() == compiler_string_consts.compiler_directive_nullbasedstrings_OFF)
{
SemanticRules.NullBasedStrings = false;
SemanticRules.ZeroBasedStrings = false;
return;
}
if (node.Name.text.ToLower() == compiler_string_consts.compiler_directive_initstring_as_empty_ON)

2
bin/Lib/PABCExtensions.pas
View file

@ -3,7 +3,7 @@
///--
unit PABCExtensions;
{$string_nullbased-}
{$zerobasedstrings off}
uses PABCSystem;

6
bin/Lib/PABCSystem.pas
View file

@ -5,7 +5,7 @@
/// !! System unit
unit PABCSystem;
{$string_nullbased-}
{$zerobasedstrings off}
{$gendoc true}
@ -12867,7 +12867,7 @@ end;
procedure PassSpaces(var s: string; var from: integer);
begin
while (from <= s.Length) and (s[from]=' ') do
while (from <= s.Length) and char.IsWhiteSpace(s[from]) do
from += 1;
end;
@ -13083,7 +13083,7 @@ end;
///--
function SystemSlice0(Self: string; situation: integer; from, &to: integer; step: integer := 1): string; extensionmethod;
begin
Result := SystemSliceStringImpl(Self, situation, from, &to, step, 0); // 0 - NullBased
Result := SystemSliceStringImpl(Self, situation, from, &to, step, 0); // 0 - ZeroBased
end;
///--

3
bin/Lng/Eng/SyntaxTreeVisitorsErrors.dat
View file

@ -46,4 +46,5 @@ FUNCTIONS_WITH_CACHE_ATTRIBUTE_SHOULD_HAVE_LESSTHEN8_PARAMETERS=Functions with [
FUNCTIONS_WITH_CACHE_ATTRIBUTE_SHOULD_HAVE_EXPLICIT_RETURN_TYPE=Functions with [Cache] attribute must have explicitely specified return type
FUNCTIONS_WITH_CACHE_ATTRIBUTE_SHOULD_NOT_HAVE_COMPOUND_NAME=Functions with [Cache] should not have compound name
FUNCTIONS_WITH_CACHE_ATTRIBUTE_SHOULD_NOT_HAVE_VAR_CONST_PARAMS_MODIFIERS=Functions with [Cache] should not have var, const or params modifier
FUNCTIONS_WITH_CACHE_ATTRIBUTE_SHOULD_BE_DEFINED_GLOBALLY=Functions with [Cache] attribute must be defined globally
FUNCTIONS_WITH_CACHE_ATTRIBUTE_SHOULD_BE_DEFINED_GLOBALLY=Functions with [Cache] attribute must be defined globally
FUNCTIONS_WITH_CACHE_ATTRIBUTE_CANNOT_HAVE_YIELD=Functions with [Cache] attribute must not contain yield statements

3
bin/Lng/Rus/SyntaxTreeVisitorsErrors.dat
View file

@ -50,4 +50,5 @@ FUNCTIONS_WITH_CACHE_ATTRIBUTE_SHOULD_HAVE_LESSTHEN8_PARAMETERS=Функции
FUNCTIONS_WITH_CACHE_ATTRIBUTE_SHOULD_HAVE_EXPLICIT_RETURN_TYPE=Функции с атрибутом [Cache] должны иметь явно указанный возвращаемый тип
FUNCTIONS_WITH_CACHE_ATTRIBUTE_SHOULD_NOT_HAVE_COMPOUND_NAME=Функции с атрибутом [Cache] не должны иметь составное имя
FUNCTIONS_WITH_CACHE_ATTRIBUTE_SHOULD_NOT_HAVE_VAR_CONST_PARAMS_MODIFIERS=Функции с атрибутом [Cache] не должны иметь var, const и params-параметры
FUNCTIONS_WITH_CACHE_ATTRIBUTE_SHOULD_BE_DEFINED_GLOBALLY=Функции с атрибутом [Cache] должны быть определены глобально
FUNCTIONS_WITH_CACHE_ATTRIBUTE_SHOULD_BE_DEFINED_GLOBALLY=Функции с атрибутом [Cache] должны быть определены глобально
FUNCTIONS_WITH_CACHE_ATTRIBUTE_CANNOT_HAVE_YIELD=Функции с атрибутом [Cache] не должны содержать оператор yield

BIN
bin/PascalABCNET.chm
View file

Binary file not shown.