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

Merge branch 'master' into features/typeclasses-another-approach

Browse source 
# Conflicts:
#	Parsers/PascalABCParserNewSaushkin/ABCPascal.cs
#	Parsers/PascalABCParserNewSaushkin/ABCPascalYacc.cs
This commit is contained in:
Bogdan Voloshin 2018-05-24 14:35:47 +03:00
parent 862d8004d6 53a7486b40
commit 32b86ece99
29 changed files with 2702 additions and 2286 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
CodeCompletion/CodeFormatter.cs
View file

@ -68,6 +68,7 @@ namespace CodeFormatters
private bool use_strong_formatting = false;
private bool skip_spaces_before = false;
private bool skip_spaces_after = false;
private bool force_tab = false;
private int addit_pos_for_multiline = 0;
private Stack<syntax_tree_node> multi_line_nodes = new Stack<syntax_tree_node>();
private FormatterOptions options;
@ -498,6 +499,9 @@ namespace CodeFormatters
sb.AppendLine();
insert_newline_after_prev = false;
}
if (force_tab && sb[sb.Length-1] == '\n')
sb.Append(new string(' ', off));
force_tab = false;
}
skip_spaces_after = false;
skip_spaces_before = false;
@ -1451,7 +1455,9 @@ namespace CodeFormatters
public override void visit(uses_list _uses_list)
{
//sb.Append("uses");
IncOffset(tab + "uses".Length - 1);
IncOffset(tab);
//if (!in_one_row(_uses_list))
force_tab = true;
for (int i = 0; i < _uses_list.units.Count; i++)
{
if (i > 0)
@ -1459,7 +1465,7 @@ namespace CodeFormatters
visit_node(_uses_list.units[i]);
}
insert_newline_after_prev = true;
DecOffset(tab + "uses".Length - 1);
DecOffset(tab);
}
public override void visit(unit_module _unit_module)

5
CodeCompletion/DomConverter.cs
View file

@ -1116,6 +1116,11 @@ namespace CodeCompletion
private bool equal_params(ProcScope ps, List<ProcScope> procs)
{
foreach (ProcScope proc in procs)
{
if ((ps.IsOverride || proc.IsOverride) && ps.IsParamsEquals(proc))
return true;
}
return false;
}

8
CodeCompletion/ExpressionVisitor.cs
View file

@ -1387,7 +1387,13 @@ namespace CodeCompletion
public override void visit(inherited_ident _inherited_ident)
{
throw new NotImplementedException();
var tmp_scope = entry_scope;
if (entry_scope.topScope is TypeScope)
{
entry_scope = (entry_scope.topScope as TypeScope).baseScope;
}
new ident(_inherited_ident.name).visit(this);
entry_scope = tmp_scope;
}
public override void visit(format_expr _format_expr)

12
CodeCompletion/Testing.cs
View file

@ -546,8 +546,14 @@ namespace CodeCompletion
s = parser.LanguageInformation.FindExpressionForMethod(off,test_str,line,col,'(',ref num_param);
assert(s.Trim(' ','\n','\t') == "Console.WriteLine");
assert(num_param==0);
test_str = "&var.&uses.&procedure";
test_str = "System.Math.DivRem";
off = test_str.Length;
s = parser.LanguageInformation.FindExpressionForMethod(off, test_str, line, col, '(', ref num_param);
assert(s.Trim(' ', '\n', '\t') == "System.Math.DivRem");
assert(num_param == 0);
test_str = "&var.&uses.&procedure";
off = test_str.Length;
s = parser.LanguageInformation.FindExpressionForMethod(off,test_str,line,col,'(',ref num_param);
assert(s == test_str);
@ -682,6 +688,8 @@ namespace CodeCompletion
assert(s.Trim(' ', '\n', '\t') == "Power");
assert(num_param == 2);
string str = null;
//mouse hover
test_str = "sin(2)";

6
Configuration/GlobalAssemblyInfo.cs
View file

@ -13,9 +13,9 @@ using System.Runtime.CompilerServices;
internal static class RevisionClass
{
public const string Major = "3";
public const string Minor = "3";
public const string Build = "5";
public const string Revision = "1669";
public const string Minor = "4";
public const string Build = "0";
public const string Revision = "1670";
public const string MainVersion = Major + "." + Minor;
public const string FullVersion = Major + "." + Minor + "." + Build + "." + Revision;

6
Configuration/Version.defs
View file

@ -1,4 +1,4 @@
%COREVERSION%=5
%REVISION%=1669
%MINOR%=3
%MINOR%=4
%REVISION%=1670
%COREVERSION%=0
%MAJOR%=3

38
InstallerSamples/LanguageFeatures/Pattern Matching/ArithmEval.pas Normal file
View file

@ -0,0 +1,38 @@
type
Expr = class
end;
Cons = auto class(Expr)
r: real;
end;
Add = auto class(Expr)
left,right: Expr;
procedure Deconstruct(var l,r: Expr);
begin
l := left; r := right;
end;
end;
Mult = auto class(Expr)
left,right: Expr;
procedure Deconstruct(var l,r: Expr);
begin
l := left; r := right;
end;
end;
Neg = auto class(Expr)
ex: Expr;
end;
function Eval(e: Expr): real;
begin
match e with
Cons(c): Result := c.r;
Neg(n): Result := -Eval(n.Ex);
Add(l,r): Result := Eval(l) + Eval(r);
Mult(l,r): Result := Eval(l) * Eval(r);
end;
end;
begin
var r := new Add(new Neg(new Cons(2)),new Mult(new Cons(3),new Cons(4)));
Eval(r).Print;
end.

87
InstallerSamples/LanguageFeatures/Pattern Matching/ArithmSimplify.pas Normal file
View file

@ -0,0 +1,87 @@
type
Expr = class
end;
V = auto class(Expr)
name: string;
procedure Deconstruct(var name: string);
begin
name := Self.name
end;
end;
Cons = auto class(Expr)
r: real;
procedure Deconstruct(var r: real);
begin
r := Self.r
end;
end;
Add = auto class(Expr)
left,right: Expr;
procedure Deconstruct(var l,r: Expr);
begin
l := left; r := right;
end;
end;
Mult = auto class(Expr)
left,right: Expr;
procedure Deconstruct(var l,r: Expr);
begin
l := left; r := right;
end;
end;
Neg = auto class(Expr)
ex: Expr;
procedure Deconstruct(var ex: Expr);
begin
ex := Self.ex
end;
end;
function NegC(ex: Expr) := new Neg(ex);
function ConsC(r: real) := new Cons(r);
function AddC(ex1,ex2: Expr) := new Add(ex1,ex2);
function MultC(ex1,ex2: Expr) := new Mult(ex1,ex2);
function VC(name: string) := new V(name);
function Simplify(e: Expr): Expr;
begin
match e with
Mult(Cons(c),Cons(c1)): Result := ConsC(c*c1);
Mult(Cons(c),ex) when c=1: Result := Simplify(ex);
Mult(Cons(c),ex) when c=0: Result := ConsC(0);
Add(Cons(c),ex) when c=0: Result := Simplify(ex);
Add(ex,Cons(c)) when c=0: Result := Simplify(ex);
Add(Cons(c),Cons(c1)): Result := ConsC(c+c1);
Neg(Cons(c)): Result := ConsC(-c);
Mult(e1,e2): Result := MultC(Simplify(e1),Simplify(e2));
Add(e1,e2): Result := AddC(Simplify(e1),Simplify(e2));
Neg(e1): Result := NegC(Simplify(e1));
else Result := e;
end;
end;
procedure Print(e: Expr);
begin
match e with
Mult(l,r): begin Print(l); Print('*'); Print(r); end;
Add(l,r): begin Print(l); Print('+'); Print(r); end;
Neg(n): begin Print('-'); Print(n); end;
Cons(c): Print(c);
V(x): Print(x);
end;
end;
begin
// 0 + 1*x + 0 + 0*(2 + a)
var r: Expr := AddC(ConsC(0),AddC(MultC(ConsC(1),VC('x')),ConsC(0)));
r := AddC(r,MultC(ConsC(0),AddC(ConsC(2),VC('a'))));
Print(r);
Println;
loop 2 do
begin
r := Simplify(r);
Print(r);
Println;
end;
end.

22
InstallerSamples/LanguageFeatures/Pattern Matching/Squares.pas Normal file
View file

@ -0,0 +1,22 @@
type
Line = class
end;
Rectangle = auto class
X,Y,Width,Height: real;
end;
Circle = auto class
X,Y,Radius: real;
end;
begin
var l := new List<Object>;
l.Add(new Line);
l.Add(new Circle(10,10,5));
l.Add(new Rectangle(10,10,20,10));
foreach var x in l do
match x with
Line(var ll): Println('Line S =',0);
Circle(var c): Println('Circle S =',c.Radius*c.Radius*Pi);
Rectangle(var r): Println('Rectangle S =',r.Width*r.Height);
end;
end.

3
ParserTools/ParserTools/DefaultLanguageInformation.cs
View file

@ -2513,7 +2513,7 @@ namespace PascalABCCompiler.Parsers
string op = Text.Substring(i - 2, 3).ToLower().Trim();
if (op == "and" || op == "div" || op == "mod" || op == "xor")
{
if (!char.IsLetterOrDigit(Text[i - 3]) && Text[i - 3] != '_' && Text[i - 3] != '&')
if (!char.IsLetterOrDigit(Text[i - 3]) && Text[i - 3] != '_' && Text[i - 3] != '&' && !(i + 1 < Text.Length && char.IsLetterOrDigit(Text[i + 1])))
{
next = i - 3;
return true;
@ -2575,6 +2575,7 @@ namespace PascalABCCompiler.Parsers
}
else if (s == "inherited")
{
bound = i + 1;
keyword = KeywordKind.Inherited;
}
else if (s == "raise")

6
Parsers/PascalABCParserNewSaushkin/ABCPascal.cs
View file

@ -1,9 +1,9 @@
//
// This CSharp output file generated by Gardens Point LEX
// Version: 1.1.3.301
// Machine: DESKTOP-7B4K9VB
// DateTime: 19.05.2018 0:21:09
// UserName: Bogdan
// Machine: OBERON
// DateTime: 5/24/2018 1:48:14 PM
// UserName: voganesyan
// GPLEX input file <ABCPascal.lex>
// GPLEX frame file <embedded resource>
//

84
Parsers/PascalABCParserNewSaushkin/ABCPascal.y
View file

@ -175,8 +175,8 @@
%type <stn> full_lambda_fp_list lambda_simple_fp_sect lambda_function_body lambda_procedure_body optional_full_lambda_fp_list
%type <ob> field_in_unnamed_object list_fields_in_unnamed_object func_class_name_ident_list rem_lambda variable_list var_ident_list
%type <ti> tkAssignOrEqual
%type <stn> pattern match_with pattern_case pattern_cases pattern_out_param
%type <ob> pattern_out_param_list
%type <stn> pattern pattern_optional_var match_with pattern_case pattern_cases pattern_out_param pattern_out_param_optional_var
%type <ob> pattern_out_param_list pattern_out_param_list_optional_var
%%
parse_goal
@ -2067,6 +2067,15 @@ constr_destr_decl
if (parsertools.build_tree_for_formatter)
$$ = new short_func_definition($$ as procedure_definition);
}
| tkClass tkConstructor optional_proc_name fp_list tkAssign unlabelled_stmt tkSemiColon
{
if ($6 is empty_statement)
parsertools.AddErrorFromResource("EMPTY_STATEMENT_IN_SHORT_PROC_DEFINITION",@7);
var tmp = new constructor(null,$4 as formal_parameters,new procedure_attributes_list(new List<procedure_attribute>(),@$),$3 as method_name,false,true,null,null,@$);
$$ = new procedure_definition(tmp as procedure_header, new block(null,new statement_list($6 as statement,@6),@6), @$);
if (parsertools.build_tree_for_formatter)
$$ = new short_func_definition($$ as procedure_definition);
}
;
inclass_constr_destr_decl
@ -2078,11 +2087,20 @@ inclass_constr_destr_decl
{
if ($5 is empty_statement)
parsertools.AddErrorFromResource("EMPTY_STATEMENT_IN_SHORT_PROC_DEFINITION",@6);
var tmp = new constructor(null,$3 as formal_parameters,new procedure_attributes_list(new List<procedure_attribute>(),@$),$2 as method_name,false,false,null,null,LexLocation.MergeAll(@1,@2,@3));
var tmp = new constructor(null,$3 as formal_parameters,new procedure_attributes_list(new List<procedure_attribute>(),@$),$2 as method_name,false,false,null,null,LexLocation.MergeAll(@1,@2,@3,@4));
$$ = new procedure_definition(tmp as procedure_header, new block(null,new statement_list($5 as statement,@5),@5), @$);
if (parsertools.build_tree_for_formatter)
$$ = new short_func_definition($$ as procedure_definition);
}
| tkClass tkConstructor optional_proc_name fp_list tkAssign unlabelled_stmt tkSemiColon
{
if ($6 is empty_statement)
parsertools.AddErrorFromResource("EMPTY_STATEMENT_IN_SHORT_PROC_DEFINITION",@7);
var tmp = new constructor(null,$4 as formal_parameters,new procedure_attributes_list(new List<procedure_attribute>(),@$),$3 as method_name,false,true,null,null,LexLocation.MergeAll(@1,@2,@3,@4));
$$ = new procedure_definition(tmp as procedure_header, new block(null,new statement_list($6 as statement,@6),@6), @$);
if (parsertools.build_tree_for_formatter)
$$ = new short_func_definition($$ as procedure_definition);
}
;
proc_func_decl
@ -2600,11 +2618,11 @@ pattern_cases
pattern_case
:
{ $$ = new empty_statement(); }
| pattern tkWhen expr_l1 tkColon unlabelled_stmt
| pattern_optional_var tkWhen expr_l1 tkColon unlabelled_stmt
{
$$ = new pattern_case($1 as pattern_node, $5 as statement, $3, @$);
}
| pattern tkColon unlabelled_stmt
| pattern_optional_var tkColon unlabelled_stmt
{
$$ = new pattern_case($1 as pattern_node, $3 as statement, null, @$);
}
@ -3067,7 +3085,34 @@ pattern
$$ = new deconstructor_pattern($3 as List<pattern_deconstructor_parameter>, $1, @$);
}
;
pattern_optional_var
: simple_or_template_type_reference tkRoundOpen pattern_out_param_list_optional_var tkRoundClose
{
$$ = new deconstructor_pattern($3 as List<pattern_deconstructor_parameter>, $1, @$);
}
;
pattern_out_param_list_optional_var
: pattern_out_param_optional_var
{
$$ = new List<pattern_deconstructor_parameter>();
($$ as List<pattern_deconstructor_parameter>).Add($1 as pattern_deconstructor_parameter);
}
| pattern_out_param_list_optional_var tkSemiColon pattern_out_param_optional_var
{
var list = $1 as List<pattern_deconstructor_parameter>;
list.Add($3 as pattern_deconstructor_parameter);
$$ = list;
}
| pattern_out_param_list_optional_var tkComma pattern_out_param_optional_var
{
var list = $1 as List<pattern_deconstructor_parameter>;
list.Add($3 as pattern_deconstructor_parameter);
$$ = list;
}
;
pattern_out_param_list
: pattern_out_param
{
@ -3086,9 +3131,24 @@ pattern_out_param_list
list.Add($3 as pattern_deconstructor_parameter);
$$ = list;
}
;
;
pattern_out_param
: tkVar identifier tkColon type_ref
{
$$ = new var_deconstructor_parameter($2, $4, @$);
}
| tkVar identifier
{
$$ = new var_deconstructor_parameter($2, null, @$);
}
| pattern
{
$$ = new recursive_deconstructor_parameter($1 as pattern_node, @$);
}
;
pattern_out_param_optional_var
: identifier tkColon type_ref
{
$$ = new var_deconstructor_parameter($1, $3, @$);
@ -3097,7 +3157,15 @@ pattern_out_param
{
$$ = new var_deconstructor_parameter($1, null, @$);
}
| pattern
| tkVar identifier tkColon type_ref
{
$$ = new var_deconstructor_parameter($2, $4, @$);
}
| tkVar identifier
{
$$ = new var_deconstructor_parameter($2, null, @$);
}
| pattern_optional_var
{
$$ = new recursive_deconstructor_parameter($1 as pattern_node, @$);
}

4612
Parsers/PascalABCParserNewSaushkin/ABCPascalYacc.cs
View file

File diff suppressed because it is too large Load diff

1
Parsers/PascalABCParserNewSaushkin/PABC.ymc
View file

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

2
ReleaseGenerators/PascalABCNET_version.nsh
View file

@ -1 +1 @@
!define VERSION '3.3.5.1669'
!define VERSION '3.4.0.1670'

6
SyntaxVisitors/SugarVisitors/PatternsDesugaringVisitor.cs
View file

@ -167,7 +167,7 @@ namespace SyntaxVisitors.SugarVisitors
desugarResult.CastVariableDefinition = new var_statement(castVariableName, pattern.type);
var successVariableName = NewSuccessName();
desugarResult.SuccessVariableDefinition = new var_statement(successVariableName, named_type_reference.Boolean);
desugarResult.SuccessVariableDefinition = new var_statement(successVariableName, new ident("false"));
// делегирование проверки паттерна функции IsTest
desugarResult.TypeCastCheck = SubtreeCreator.CreateSystemFunctionCall(IsTestMethodName, matchingExpression, castVariableName);
@ -216,9 +216,9 @@ namespace SyntaxVisitors.SugarVisitors
{
if (parameters[i] is recursive_deconstructor_parameter parameter)
{
var parameterType = (parameter.pattern as deconstructor_pattern).type;
//var parameterType = (parameter.pattern as deconstructor_pattern).type;
var newName = NewGeneralName();
var varParameter = new var_deconstructor_parameter(newName, parameterType);
var varParameter = new var_deconstructor_parameter(newName, null);
parameters[i] = varParameter;
varParameter.Parent = parameters[i];
conjunction = bin_expr.LogicalAnd(conjunction, DesugarRecursiveDeconstructor(newName, parameter.pattern as deconstructor_pattern));

12
TestSuite/CompilationSamples/graph3d.pas
View file

@ -473,20 +473,20 @@ type
transfgroup.Children[0] := new MatrixTransform3D(m);
Result := Self;
end);
function AnimMoveTo(x, y, z: real; seconds: real := 1; Completed: procedure := nil): MyAnimation;
function AnimMoveTo(x, y, z: real; seconds: real; Completed: procedure): MyAnimation;
function AnimMoveTo(x, y, z: real; seconds: real := 1): MyAnimation := AnimMoveTo(x,y,z,seconds,nil);
function AnimMoveTo(p: Point3D; seconds: real := 1; Completed: procedure := nil) := AnimMoveTo(p.x, p.y, p.z, seconds, Completed);
function AnimMoveTo(p: Point3D; seconds: real; Completed: procedure) := AnimMoveTo(p.x, p.y, p.z, seconds, Completed);
function AnimMoveTo(p: Point3D; seconds: real := 1) := AnimMoveTo(p.x, p.y, p.z, seconds, nil);
function AnimMoveTrajectory(a: sequence of Point3D; seconds: real := 1; Completed: procedure := nil): MyAnimation;
function AnimMoveTrajectory(a: sequence of Point3D; seconds: real; Completed: procedure): MyAnimation;
function AnimMoveTrajectory(a: sequence of Point3D; seconds: real := 1): MyAnimation := AnimMoveTrajectory(a,seconds,nil);
//function AnimMoveToP3D(x,y,z: real; seconds: real := 1): MyAnimation; - не получилось! Свойство не анимируется!
function AnimMoveOn(dx, dy, dz: real; seconds: real := 1; Completed: procedure := nil): MyAnimation;
function AnimMoveOn(dx, dy, dz: real; seconds: real; Completed: procedure): MyAnimation;
function AnimMoveOn(dx, dy, dz: real; seconds: real := 1): MyAnimation := AnimMoveOn(dx,dy,dz,seconds,nil);
function AnimMoveOn(v: Vector3D; seconds: real := 1; Completed: procedure := nil) := AnimMoveOn(v.x, v.y, v.z, seconds, Completed);
function AnimMoveOn(v: Vector3D; seconds: real; Completed: procedure) := AnimMoveOn(v.x, v.y, v.z, seconds, Completed);
function AnimMoveOn(v: Vector3D; seconds: real := 1) := AnimMoveOn(v.x, v.y, v.z, seconds, nil);
// Что-то одна версия с параметрами по умолчанию не на всех компьютерах срабатывает, поэтому сделал без параметров по умолчанию
@ -513,7 +513,7 @@ type
function AnimRotate(v: Vector3D; angle: real; seconds: real; Completed: procedure) := AnimRotate(v.x, v.y, v.z, angle, seconds, Completed);
function AnimRotate(v: Vector3D; angle: real; seconds: real := 1) := AnimRotate(v.x, v.y, v.z, angle, seconds, nil);
function AnimRotateAt(axis: Vector3D; angle: real; center: Point3D; seconds: real := 1; Completed: procedure := nil): MyAnimation;
function AnimRotateAt(axis: Vector3D; angle: real; center: Point3D; seconds: real; Completed: procedure): MyAnimation;
function AnimRotateAt(axis: Vector3D; angle: real; center: Point3D; seconds: real := 1): MyAnimation := AnimRotateAt(axis,angle,center,seconds,nil);
function Clone: Object3D := Invoke&<Object3D>(CloneT);

8
TestSuite/ShortClassConstructor.pas Normal file
View file

@ -0,0 +1,8 @@
type
t1 = class
class constructor := Assert(True);
end;
begin
var t := new t1;
end.

5
TestSuite/formatter_tests/input/uses1.pas Normal file
View file

@ -0,0 +1,5 @@
uses
System;
begin
end.

6
TestSuite/formatter_tests/input/uses2.pas Normal file
View file

@ -0,0 +1,6 @@
uses
System,
System.Collections;
begin
end.

4
TestSuite/formatter_tests/input/uses3.pas Normal file
View file

@ -0,0 +1,4 @@
uses System,System.Collections;
begin
end.

5
TestSuite/formatter_tests/should/uses1.pas Normal file
View file

@ -0,0 +1,5 @@
uses
System;
begin
end.

6
TestSuite/formatter_tests/should/uses2.pas Normal file
View file

@ -0,0 +1,6 @@
uses
System,
System.Collections;
begin
end.

4
TestSuite/formatter_tests/should/uses3.pas Normal file
View file

@ -0,0 +1,4 @@
uses System, System.Collections;
begin
end.

20
TestSuite/intellisense_tests/inherited1.pas Normal file
View file

@ -0,0 +1,20 @@
type
t1=class
procedure p1; virtual;
begin
end;
end;
t2=class(t1)
procedure p1; override;
begin
inherited p1{@procedure t1.p1(); virtual;@}();
end;
end;
t3=class(t2)
procedure p1; override;
begin
inherited p1{@procedure t2.p1(); override;@};
end;
end;
begin end.

2
TestSuite/patterns-is-in-lambda.pas
View file

@ -1,4 +1,4 @@
begin
var res := Arr(object(new List<integer>), object('asd'), object(1), object(2.0)).First(x -> x is string(s));
var res := Arr(object(new List<integer>), object('asd'), object(1), object(2.0)).First(x -> x is string(var s));
Assert(res = 'asd');
end.

4
TestSuite/patterns-is-nested-if.pas
View file

@ -1,7 +1,7 @@
begin
var a:='asd';
if (a is string(s)) and (s is string(s1)) then
if (s1 is string(s2)) and (s2 is string(s3)) and (s3 = 'asd') then
if (a is string(var s)) and (s is string(var s1)) then
if (s1 is string(var s2)) and (s2 is string(var s3)) and (s3 = 'asd') then
Assert(s3 = 'asd')
else
Assert(false)

2
TestSuite/patterns-is-recursive.pas
View file

@ -13,7 +13,7 @@ begin
var p := new Pair<integer, string>;
p._a := 1;
p._b := 'asd';
if p is Pair<integer, string>(integer(a), string(b)) then
if p is Pair<integer, string>(integer(var a), string(var b)) then
Assert((a = 1) and (b = 'asd'))
else
Assert(false);

2
TestSuite/patterns-yield-test.pas → TestSuite/patterns-is-yield-test.pas
View file

@ -1,6 +1,6 @@
function Y1(): sequence of integer;
begin
if 1 is integer(i) then
if 1 is integer(var i) then
yield i;
end;