Add to examples Eq, Show and Read typeclasses
This commit is contained in:
parent
c0bdc307e1
commit
e26cdc9c15
145
CodeExamples/SimpleTypeclassesImplementation.pas
Normal file
145
CodeExamples/SimpleTypeclassesImplementation.pas
Normal file
|
|
@ -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.
|
||||
|
|
@ -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);
|
||||
|
|
|
|||
Loading…
Reference in a new issue