fix #138

Configuration/GlobalAssemblyInfo.cs

@@ -15,7 +15,7 @@ internal static class RevisionClass
 	public const string Major = "3";
 	public const string Minor = "1";
 	public const string Build = "0";
-	public const string Revision = "1218";
+	public const string Revision = "1223";
 
         public const string MainVersion = Major + "." + Minor;
 	public const string FullVersion = Major + "." + Minor + "." + Build + "." + Revision;

Configuration/Version.defs

@@ -1,4 +1,4 @@
-%MINOR%=1
-%REVISION%=1218
 %COREVERSION%=0
+%REVISION%=1223
+%MINOR%=1
 %MAJOR%=3

Parsers/PascalABCParserNewSaushkin/ABCPascal.cs

@@ -2,7 +2,7 @@
 //  This CSharp output file generated by Gardens Point LEX
 //  Version:  1.1.3.301
 //  Machine:  SSM
-//  DateTime: 13.04.2016 11:35:20
+//  DateTime: 18.04.2016 14:09:33
 //  UserName: ?????????
 //  GPLEX input file <ABCPascal.lex>
 //  GPLEX frame file <embedded resource>

Parsers/PascalABCParserNewSaushkin/ABCPascal.y

@@ -3654,6 +3654,42 @@ lambda_function_body
 		{
 			$$ = $1;
 		}
+    | if_stmt
+		{
+			$$ = new statement_list($1 as statement, @$);
+		}
+	| while_stmt
+		{
+			$$ = new statement_list($1 as statement, @$);
+		}
+	| repeat_stmt
+		{
+			$$ = new statement_list($1 as statement, @$);
+		}
+	| for_stmt
+		{
+			$$ = new statement_list($1 as statement, @$);
+		}
+	| foreach_stmt
+		{
+			$$ = new statement_list($1 as statement, @$);
+		}
+	| case_stmt
+		{
+			$$ = new statement_list($1 as statement, @$);
+		}
+	| try_stmt
+		{
+			$$ = new statement_list($1 as statement, @$);
+		}
+	| lock_stmt
+		{
+			$$ = new statement_list($1 as statement, @$);
+		}
+	| yield_stmt
+		{
+			$$ = new statement_list($1 as statement, @$);
+		}
 	;	
 
 lambda_procedure_body
@@ -3665,7 +3701,7 @@ lambda_procedure_body
 		{
 			$$ = $1;
 		}
-	| if_stmt
+    | if_stmt
 		{
 			$$ = new statement_list($1 as statement, @$);
 		}

Parsers/PascalABCParserNewSaushkin/PABC.tags

@@ -34,7 +34,6 @@
     <name value="one_literal" />
     <name value="literal" />
     <name value="literal_list" />
-    <name value="lambda_function_body" />
   </tag>
   <tag value="Списки">
     <name value="decl_sect_list" />

Parsers/PascalABCParserNewSaushkin/PABC.ymc

@@ -128,6 +128,8 @@ script=
 
 
 
+
+
 
 
 

ReleaseGenerators/PascalABCNET_version.nsh

@@ -1 +1 @@
-!define VERSION '3.1.0.1218'
+!define VERSION '3.1.0.1223'

TestSuite/CompilationSamples/LambdaProc1.pas

@@ -0,0 +1,3 @@
+begin
+  Arr(1,2,3).ForEach(x -> Print(x));
+end.

TestSuite/CompilationSamples/LambdaProc2.pas

@@ -0,0 +1,3 @@
+begin
+  Arr(1,2,3).ForEach(x -> if x>1 then Print(x));
+end.

TestSuite/CompilationSamples/PABCSystem.pas

@@ -111,7 +111,7 @@ type
   /// Представляет кортеж
   Tuple = System.Tuple;
   
-  /// Представляет динамический массив 
+  /// Представляет список на базе динамического массива
   List<T> = System.Collections.Generic.List<T>;
   
   /// Представляет базовый класс для реализации интерфейса IComparer
@@ -7781,13 +7781,15 @@ end;
 // -----------------------------------------------------
 // Дополнения февраль 2016: Iterate, Step, &Repeat, Cycle
 
-/// Возвращает бесконечную рекуррентную последовательность элементов, задаваемую начальным элементом и функцией next
+// Возвращает бесконечную рекуррентную последовательность элементов, задаваемую начальным элементом и функцией next
+///--
 function Iterate<T>(Self: T; next: T -> T): sequence of T; extensionmethod;
 begin
   Result := Iterate&<T>(Self,next);
 end;
 
-/// Возвращает бесконечную рекуррентную последовательность элементов, задаваемую начальным элементом, следующим за ним элементом и функцией next
+// Возвращает бесконечную рекуррентную последовательность элементов, задаваемую начальным элементом, следующим за ним элементом и функцией next
+///--
 function Iterate<T>(Self,second: T; next: (T,T) -> T): sequence of T; extensionmethod;
 begin
   Result := Iterate&<T>(Self,second,next);
@@ -7813,7 +7815,8 @@ begin
   Result := IntNumbersClass.Create().Select(x->x*step+slf);
 end;
 
-/// Возвращает бесконечную последовательность элементов, совпадающих с данным
+// Возвращает бесконечную последовательность элементов, совпадающих с данным
+///--
 function &Repeat<T>(Self: T): sequence of T; extensionmethod;
 begin
   Result := SeqFill(MaxInt,Self);

TreeConverter/TreeConversion/syntax_tree_visitor.cs

@@ -5934,7 +5934,8 @@ namespace PascalABCCompiler.TreeConverter
                 {
                     
             		expression_node bfcint = make_read_call(si, _method_call.parameters, subloc2);
-                    if (!proc_wait) AddError(subloc2, "FUNCTION_EXPECTED_PROCEDURE_{0}_MEET", (si.sym_info as function_node).name);
+                    if (!proc_wait)
+                        AddError(subloc2, "FUNCTION_EXPECTED_PROCEDURE_{0}_MEET", (si.sym_info as function_node).name);
                     switch (mot)
                     {
                         case motivation.expression_evaluation:
@@ -6192,7 +6193,8 @@ namespace PascalABCCompiler.TreeConverter
             else if (SystemLibrary.SystemLibInitializer.IncProcedure.Equal(si))
             {
             	expression_node bfcint = make_inc_call(si, _method_call.parameters, subloc2);
-            	if (!proc_wait) AddError(subloc2, "FUNCTION_EXPECTED_PROCEDURE_{0}_MEET", (si.sym_info as function_node).name);
+            	if (!proc_wait)
+                        AddError(subloc2, "FUNCTION_EXPECTED_PROCEDURE_{0}_MEET", (si.sym_info as function_node).name);
             	switch (mot)
                     {
                         case motivation.expression_evaluation:
@@ -6217,7 +6219,8 @@ namespace PascalABCCompiler.TreeConverter
             else if (SystemLibrary.SystemLibInitializer.DecProcedure.Equal(si))
             {
             	expression_node bfcint = make_dec_call(si, _method_call.parameters, subloc2);
-            	if (!proc_wait) AddError(subloc2, "FUNCTION_EXPECTED_PROCEDURE_{0}_MEET", (si.sym_info as function_node).name);
+            	if (!proc_wait)
+                        AddError(subloc2, "FUNCTION_EXPECTED_PROCEDURE_{0}_MEET", (si.sym_info as function_node).name);
             	switch (mot)
                     {
                         case motivation.expression_evaluation:
@@ -6374,7 +6377,8 @@ namespace PascalABCCompiler.TreeConverter
             else if (si == SystemLibrary.SystemLibInitializer.NewProcedure)
             {
             	expression_node bfcint = make_new_call(si, _method_call.parameters, subloc2);
-            	if (!proc_wait) AddError(subloc2, "FUNCTION_EXPECTED_PROCEDURE_{0}_MEET", (si.sym_info as function_node).name);
+            	if (!proc_wait)
+                        AddError(subloc2, "FUNCTION_EXPECTED_PROCEDURE_{0}_MEET", (si.sym_info as function_node).name);
             	switch (mot)
                     {
                         case motivation.expression_evaluation:
@@ -6401,7 +6405,8 @@ namespace PascalABCCompiler.TreeConverter
                 //if (convertion_data_and_alghoritms.select_function(convert_expression_list(_method_call.parameters.expressions), si, subloc2) == SystemLibrary.SystemLibInitializer.DisposeProcedure.sym_info)
                 //{
                     expression_node bfcint = make_dispose_call(si, _method_call.parameters, subloc2);
-                    if (!proc_wait) AddError(subloc2, "FUNCTION_EXPECTED_PROCEDURE_{0}_MEET", (si.sym_info as function_node).name);
+                    if (!proc_wait)
+                        AddError(subloc2, "FUNCTION_EXPECTED_PROCEDURE_{0}_MEET", (si.sym_info as function_node).name);
                     switch (mot)
                     {
                         case motivation.expression_evaluation:
@@ -18372,6 +18377,46 @@ namespace PascalABCCompiler.TreeConverter
 
         public override void visit(SyntaxTree.function_lambda_definition _function_lambda_definition)
         {
+            // SSM 18/04/16 попытка разрешить x->Print(x)
+            var stl = _function_lambda_definition.proc_body as SyntaxTree.statement_list;
+            if (_function_lambda_definition.return_type is lambda_inferred_type && stl != null && stl.list.Count == 1)
+            {
+                var ass = (_function_lambda_definition.proc_body as SyntaxTree.statement_list).list[0] as assign;
+                if (ass != null && ass.to is ident && (ass.to as ident).name.ToLower()=="result")
+                {
+                    var f = ass.from;
+                    if (f is method_call)
+                    {
+                        var ff = f as method_call;
+                        // Надо посмотреть, как это делается для преобразования типов T(x). А пока так
+                        expression_node qq = null; 
+                        delegated_methods dm = null;
+                        try
+                        {
+                            qq = convert_strong(ff.dereferencing_value);
+                            dm = qq.type as delegated_methods;
+                        }
+                        catch
+                        {
+                             // Погасить все исключения. Значит, не вывелось, и в правой части лямбды - не вызов процедуры, а скорее всего приведение типа T(x)
+                        }
+                        if (dm != null && dm.proper_methods != null && dm.proper_methods.Count > 0)
+                        {
+                            if (dm.proper_methods[0].ret_type == null)
+                            {
+                                // Очищаем от Result :=
+                                (_function_lambda_definition.proc_body as SyntaxTree.statement_list).list[0] = new procedure_call(ff, ff.source_context); // заменить result := Print(x) на Print(x)
+                                _function_lambda_definition.return_type = null;
+                            }
+                        }
+                    }
+                }
+                else // значит, первый и единственный оператор - не присваивание и это лямбда - процедура!
+                {
+                    _function_lambda_definition.return_type = null;
+                }
+            }
+
             _function_lambda_definition.RealSemTypeOfResExpr = null; // После первого присваивания Result она будет содержать тип type_node в правой части Result
             _function_lambda_definition.RealSemTypeOfResult = null;
             try

bin/Lib/PABCSystem.pas

@@ -111,7 +111,7 @@ type
   /// Представляет кортеж
   Tuple = System.Tuple;
   
-  /// Представляет список
+  /// Представляет список на базе динамического массива
   List<T> = System.Collections.Generic.List<T>;
   
   /// Представляет базовый класс для реализации интерфейса IComparer