From e26cdc9c15d6b2c68dd6112833ae3a5ba6dc6ebb Mon Sep 17 00:00:00 2001
From: Bogdan Voloshin <ya.bovi2012@yandex.ru>
Date: Thu, 26 Apr 2018 19:29:58 +0300
Subject: [PATCH] Add to examples Eq, Show and Read typeclasses

---
 .../SimpleTypeclassesImplementation.pas       | 145 ++++++++++++++++++
 .../ReplaceTypeclassVisitor.cs                |   4 +-
 2 files changed, 147 insertions(+), 2 deletions(-)
 create mode 100644 CodeExamples/SimpleTypeclassesImplementation.pas

diff --git a/CodeExamples/SimpleTypeclassesImplementation.pas b/CodeExamples/SimpleTypeclassesImplementation.pas
new file mode 100644
index 000000000..50a3f411f
--- /dev/null
+++ b/CodeExamples/SimpleTypeclassesImplementation.pas
@@ -0,0 +1,145 @@
+uses System;
+
+
+type
+  TMonthType = (January, February, March, April,May, June, July, August, September, October, November, December);
+
+
+type
+  // ---Typeclasses---
+  
+  
+  Eq[T] = typeclass
+    function equal(x, y: T): boolean;
+    begin
+      Result := not notEqual(x, y);
+    end;
+    
+    function notEqual(x, y: T) := not equal(x, y);
+  end;
+  
+  
+  Show[T] = typeclass
+    function show(x: T): string;
+  end;
+  
+  
+  Read[T] = typeclass
+    function read(s:string): T;
+  end;
+  
+  
+  
+  
+  // ---Instances---
+  
+  
+  Eq[integer] = instance
+    function equal(x, y: integer):boolean := x = y;
+  end;
+  
+  
+  Show[boolean] = instance
+    function show(x: boolean): string := x ? 'Правда': 'Ложь';
+  end;
+  
+  
+  Read[TMonthType] = instance
+    function read(s:string): TMonthType;
+    begin
+      var t := typeof(TMonthType);
+      Result := TMonthType(Enum.Parse(t, s));
+    end;
+  end;
+
+
+// ---Functions---
+
+
+function ArrayEq<T>(l1, l2: array of T): boolean; where Eq[T];
+begin
+  Result := true;
+  for var i :=0 to l1.Length - 1 do
+    if Eq&[T].notEqual(l1[i], l2[i]) then
+    begin
+      Result := false;
+      break;
+    end;
+end;
+
+
+procedure ShowNTimes<T>(x: T; n: integer); where Show[T];
+begin
+  for var i:= 1 to n do
+    writeln(Show&[T].show(x));
+end;
+
+
+function ReadListOfMonths<T>(x: array of string): array of T; where Read[T];
+begin
+  Result := new T[x.Length];
+  for var i := 0 to x.Length - 1 do
+  begin
+    Result[i] := Read&[T].read(x[i]);
+  end;
+end;
+
+
+// ---Test Functions---
+
+
+procedure TestEq();
+begin
+  writeln('TestEq');
+  begin
+    var l1 := Arr(1,3,5,7,8); 
+    var l2 := Arr(1,3,5,7,8); 
+  
+    writeln(ArrayEq&[integer](l1, l2));
+  end;
+  
+  begin
+    var l1 := Arr(1,3,5,7,8); 
+    var l2 := Arr(1,3,5,1,8); 
+  
+    writeln(ArrayEq&[integer](l1, l2));
+  end;
+  
+end;
+
+
+procedure TestShow();
+begin
+  writeln('TestShow');
+  ShowNTimes&[boolean](false, 2);
+  ShowNTimes&[boolean](true, 4);
+end;
+
+
+procedure TestRead();
+begin
+  writeln('TestRead');
+  var a := Arr(January, February, March, April);
+  var b := Arr('January', 'February', 'March', 'April');
+  
+  var c := ReadListOfMonths&[TMonthType](b);
+  var isCorrect := true;
+  for var i := 0 to a.Length - 1 do
+  begin
+    if a[i] <> c[i] then
+    begin
+      isCorrect := false;
+      break;
+    end;
+  end;
+  writeln(isCorrect);
+end;
+
+
+begin
+
+  TestEq();
+  TestShow();
+  TestRead();
+  
+end.
\ No newline at end of file
diff --git a/SyntaxVisitors/TypeclassVisitors/ReplaceTypeclassVisitor.cs b/SyntaxVisitors/TypeclassVisitors/ReplaceTypeclassVisitor.cs
index 8843612da..e7d751178 100644
--- a/SyntaxVisitors/TypeclassVisitors/ReplaceTypeclassVisitor.cs
+++ b/SyntaxVisitors/TypeclassVisitors/ReplaceTypeclassVisitor.cs
@@ -46,7 +46,6 @@ namespace SyntaxVisitors.TypeclassVisitors
 
                 for (int j = 0; j < cm.Count; j++)
                 {
-                    // TODO: or override if implementation exists
                     (cm[j] as procedure_header)?.proc_attributes.Add(new procedure_attribute("override", proc_attribute.attr_override));
                     (cm[j] as procedure_definition)?.proc_header.proc_attributes.Add(new procedure_attribute("override", proc_attribute.attr_override));
                 }
@@ -109,8 +108,8 @@ namespace SyntaxVisitors.TypeclassVisitors
 
                 for (int j = 0; j < cm.Count; j++)
                 {
-                    // TODO: or override if implementation exists
                     (cm[j] as procedure_header)?.proc_attributes.Add(new procedure_attribute("abstract", proc_attribute.attr_abstract));
+                    (cm[j] as procedure_definition)?.proc_header.proc_attributes.Add(new procedure_attribute("virtual", proc_attribute.attr_virtual));
                 }
             }
 
@@ -212,6 +211,7 @@ namespace SyntaxVisitors.TypeclassVisitors
             }
 
             // Add new templates devoted to constraints to template list
+            // TODO: template_args can be empty, if there is no <T> or smth, need to check
             headerTranslated.template_args.idents.AddRange(additionalTemplateArgs.idents);
 
             var blockProc = (_procedure_definition.proc_body as block);