Add typeclass deriving translation
This commit is contained in:
Voloshin Bogdan
parent
8611330699
commit
950ca1c711
|
|
@ -4,7 +4,7 @@ type
|
|||
TMonthType = (January, February, March, April, May, June, July, August, September, October, November, December);
|
||||
|
||||
|
||||
Ordering = (_EQ, _LT, _GL);
|
||||
Ordering = (_EQ, _LT, _GT);
|
||||
|
||||
|
||||
type
|
||||
|
|
@ -17,10 +17,56 @@ type
|
|||
Result := not notEqual(x, y);
|
||||
end;
|
||||
|
||||
function notEqual(x, y: T) := not equal(x, y);
|
||||
function notEqual(x, y: T): boolean;
|
||||
begin
|
||||
Result := not equal(x, y);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
Ord[T] = typeclass(Eq[T])
|
||||
function compare(x, y: T): Ordering;
|
||||
begin
|
||||
if equal(x, y) then
|
||||
Result := _EQ
|
||||
else if less(x, y) then
|
||||
Result := _LT
|
||||
else
|
||||
Result := _GT;
|
||||
end;
|
||||
|
||||
function less(x, y: T): boolean;
|
||||
begin
|
||||
Result := compare(x, y) = _LT;
|
||||
end;
|
||||
|
||||
function lessEqual(x, y: T): boolean;
|
||||
begin
|
||||
Result := compare(x, y) <> _GT;
|
||||
end;
|
||||
|
||||
function greater(x, y: T): boolean;
|
||||
begin
|
||||
Result := compare(x, y) = _GT;
|
||||
end;
|
||||
|
||||
function greaterEqual(x, y: T): boolean;
|
||||
begin
|
||||
Result := compare(x, y) <> _LT;
|
||||
end;
|
||||
|
||||
function min(x, y: T): T;
|
||||
begin
|
||||
Result := lessEqual(x, y) ? x : y;
|
||||
end;
|
||||
|
||||
function max(x, y: T): T;
|
||||
begin
|
||||
Result := lessEqual(x, y) ? y : x;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
Show[T] = typeclass
|
||||
function show(x: T): string;
|
||||
end;
|
||||
|
|
@ -44,6 +90,20 @@ type
|
|||
function equal(x, y: integer):boolean := x = y;
|
||||
end;
|
||||
|
||||
(*
|
||||
Ord[integer] = instance
|
||||
function compare(x, y: integer): Ordering;
|
||||
begin
|
||||
if equal(x, y) then
|
||||
Result := _EQ
|
||||
else if x < y then
|
||||
Result := _LT
|
||||
else
|
||||
Result := _GT;
|
||||
end;
|
||||
end;
|
||||
*)
|
||||
|
||||
|
||||
Show[boolean] = instance
|
||||
function show(x: boolean): string := x ? 'Правда': 'Ложь';
|
||||
|
|
@ -96,6 +156,26 @@ begin
|
|||
end;
|
||||
end;
|
||||
|
||||
(*
|
||||
procedure MySort<T>(var a: array of T); where Ord[T];
|
||||
begin
|
||||
for var i := 1 to a.Length - 1 do
|
||||
begin
|
||||
var sorted := true;
|
||||
for var j := 0 to a.Length - 1 - i do
|
||||
begin
|
||||
if Ord&[T].greater(a[i - 1], a[i]) then
|
||||
begin
|
||||
swap(a[i - 1], a[i]);
|
||||
sorted := false;
|
||||
end;
|
||||
end;
|
||||
|
||||
if sorted then
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
*)
|
||||
|
||||
// ---Test Functions---
|
||||
|
||||
|
|
@ -147,11 +227,26 @@ begin
|
|||
writeln(isCorrect);
|
||||
end;
|
||||
|
||||
(*
|
||||
procedure TestOrd();
|
||||
begin
|
||||
var a := Arr(3, 1, 4, 2, 5, 0);
|
||||
var res := Arr(a);
|
||||
|
||||
Sort(res);
|
||||
MySort&[integer](a);
|
||||
|
||||
var isCorrect := a.SequenceEqual(res);
|
||||
|
||||
writeln(isCorrect);
|
||||
|
||||
end;
|
||||
*)
|
||||
begin
|
||||
|
||||
TestEq();
|
||||
TestShow();
|
||||
TestRead();
|
||||
// TestOrd();
|
||||
|
||||
end.
|
||||
|
|
@ -39,8 +39,7 @@
|
|||
|
||||
function compare(x, y: T): Ordering; virtual;
|
||||
begin
|
||||
var eqInst := __ConceptSingleton&<EqT>.&Instance;
|
||||
if eqInst.eequal(x, y) then
|
||||
if eequal(x, y) then
|
||||
Result := _EQ
|
||||
else if less(x, y) then
|
||||
Result := _LT
|
||||
|
|
@ -108,7 +107,7 @@
|
|||
|
||||
function compare(x, y: integer): Ordering; override;
|
||||
begin
|
||||
if self.eequal(x, y) then
|
||||
if eequal(x, y) then
|
||||
Result := _EQ
|
||||
else if x < y then
|
||||
Result := _LT
|
||||
|
|
@ -118,6 +117,19 @@
|
|||
end;
|
||||
|
||||
|
||||
function ArrayEq<T, EqT>(l1, l2: array of T): boolean; where EqT: IEq<T>, constructor;
|
||||
begin
|
||||
var eqtinstance := __ConceptSingleton&<EqT>.&Instance;
|
||||
Result := true;
|
||||
for var i :=0 to l1.Length - 1 do
|
||||
if eqtinstance.notEqual(l1[i], l2[i]) then
|
||||
begin
|
||||
Result := false;
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function Max3<T, OrdT>(v1, v2, v3: T): T;
|
||||
where OrdT: IOrd<T>, constructor;
|
||||
begin
|
||||
|
|
|
|||
|
|
@ -1,9 +1,9 @@
|
|||
//
|
||||
// This CSharp output file generated by Gardens Point LEX
|
||||
// Version: 1.1.3.301
|
||||
// Machine: OBERON
|
||||
// DateTime: 4/18/2018 6:59:00 PM
|
||||
// UserName: voganesyan
|
||||
// Machine: DESKTOP-7B4K9VB
|
||||
// DateTime: 08.05.2018 15:03:52
|
||||
// UserName: Bogdan
|
||||
// GPLEX input file <ABCPascal.lex>
|
||||
// GPLEX frame file <embedded resource>
|
||||
//
|
||||
|
|
|
|||
|
|
@ -1561,6 +1561,11 @@ base_class_name
|
|||
{ $$ = $1; }
|
||||
| template_type
|
||||
{ $$ = $1; }
|
||||
| typeclass_restriction
|
||||
{
|
||||
var names = new List<ident>();
|
||||
names.Add(($1 as typeclass_restriction).name);
|
||||
$$ = new typeclass_reference(null, names, ($1 as typeclass_restriction).restriction_args); }
|
||||
;
|
||||
|
||||
template_arguments
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load diff
|
|
@ -1142,6 +1142,11 @@ namespace PascalABCCompiler.SyntaxTree
|
|||
{
|
||||
DefaultVisit(_typeclass_param_list);
|
||||
}
|
||||
|
||||
public virtual void visit(typeclass_reference _typeclass_reference)
|
||||
{
|
||||
DefaultVisit(_typeclass_reference);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -1821,6 +1821,14 @@ namespace PascalABCCompiler.SyntaxTree
|
|||
{
|
||||
}
|
||||
|
||||
public virtual void pre_do_visit(typeclass_reference _typeclass_reference)
|
||||
{
|
||||
}
|
||||
|
||||
public virtual void post_do_visit(typeclass_reference _typeclass_reference)
|
||||
{
|
||||
}
|
||||
|
||||
public override void visit(expression _expression)
|
||||
{
|
||||
DefaultVisit(_expression);
|
||||
|
|
@ -3763,6 +3771,14 @@ namespace PascalABCCompiler.SyntaxTree
|
|||
pre_do_visit(_typeclass_param_list);
|
||||
post_do_visit(_typeclass_param_list);
|
||||
}
|
||||
|
||||
public override void visit(typeclass_reference _typeclass_reference)
|
||||
{
|
||||
DefaultVisit(_typeclass_reference);
|
||||
pre_do_visit(_typeclass_reference);
|
||||
visit(typeclass_reference.restriction_args);
|
||||
post_do_visit(_typeclass_reference);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -474,6 +474,8 @@ namespace PascalABCCompiler.SyntaxTree
|
|||
return new where_typeclass_constraint();
|
||||
case 226:
|
||||
return new typeclass_param_list();
|
||||
case 227:
|
||||
return new typeclass_reference();
|
||||
}
|
||||
return null;
|
||||
}
|
||||
|
|
@ -3990,6 +3992,18 @@ namespace PascalABCCompiler.SyntaxTree
|
|||
read_template_param_list(_typeclass_param_list);
|
||||
}
|
||||
|
||||
|
||||
public void visit(typeclass_reference _typeclass_reference)
|
||||
{
|
||||
read_typeclass_reference(_typeclass_reference);
|
||||
}
|
||||
|
||||
public void read_typeclass_reference(typeclass_reference _typeclass_reference)
|
||||
{
|
||||
read_named_type_reference(_typeclass_reference);
|
||||
_typeclass_reference.restriction_args = _read_node() as template_param_list;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -6244,6 +6244,27 @@ namespace PascalABCCompiler.SyntaxTree
|
|||
write_template_param_list(_typeclass_param_list);
|
||||
}
|
||||
|
||||
|
||||
public void visit(typeclass_reference _typeclass_reference)
|
||||
{
|
||||
bw.Write((Int16)227);
|
||||
write_typeclass_reference(_typeclass_reference);
|
||||
}
|
||||
|
||||
public void write_typeclass_reference(typeclass_reference _typeclass_reference)
|
||||
{
|
||||
write_named_type_reference(_typeclass_reference);
|
||||
if (_typeclass_reference.restriction_args == null)
|
||||
{
|
||||
bw.Write((byte)0);
|
||||
}
|
||||
else
|
||||
{
|
||||
bw.Write((byte)1);
|
||||
_typeclass_reference.restriction_args.visit(this);
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -48225,8 +48225,8 @@ namespace PascalABCCompiler.SyntaxTree
|
|||
FillParentsInDirectChilds();
|
||||
}
|
||||
public typeclass_param_list(template_param_list _template_param_list): this(_template_param_list.dereferencing_value, _template_param_list.params_list, _template_param_list.source_context)
|
||||
{
|
||||
}
|
||||
{
|
||||
}
|
||||
|
||||
/// <summary> Создает копию узла </summary>
|
||||
public override syntax_tree_node Clone()
|
||||
|
|
@ -48373,6 +48373,238 @@ namespace PascalABCCompiler.SyntaxTree
|
|||
}
|
||||
|
||||
|
||||
///<summary>
|
||||
///
|
||||
///</summary>
|
||||
[Serializable]
|
||||
public partial class typeclass_reference : named_type_reference
|
||||
{
|
||||
|
||||
///<summary>
|
||||
///Конструктор без параметров.
|
||||
///</summary>
|
||||
public typeclass_reference()
|
||||
{
|
||||
|
||||
}
|
||||
|
||||
///<summary>
|
||||
///Конструктор с параметрами.
|
||||
///</summary>
|
||||
public typeclass_reference(template_param_list _restriction_args)
|
||||
{
|
||||
this._restriction_args=_restriction_args;
|
||||
FillParentsInDirectChilds();
|
||||
}
|
||||
|
||||
///<summary>
|
||||
///Конструктор с параметрами.
|
||||
///</summary>
|
||||
public typeclass_reference(template_param_list _restriction_args,SourceContext sc)
|
||||
{
|
||||
this._restriction_args=_restriction_args;
|
||||
source_context = sc;
|
||||
FillParentsInDirectChilds();
|
||||
}
|
||||
|
||||
///<summary>
|
||||
///Конструктор с параметрами.
|
||||
///</summary>
|
||||
public typeclass_reference(type_definition_attr_list _attr_list,List<ident> _names,template_param_list _restriction_args)
|
||||
{
|
||||
this._attr_list=_attr_list;
|
||||
this._names=_names;
|
||||
this._restriction_args=_restriction_args;
|
||||
FillParentsInDirectChilds();
|
||||
}
|
||||
|
||||
///<summary>
|
||||
///Конструктор с параметрами.
|
||||
///</summary>
|
||||
public typeclass_reference(type_definition_attr_list _attr_list,List<ident> _names,template_param_list _restriction_args,SourceContext sc)
|
||||
{
|
||||
this._attr_list=_attr_list;
|
||||
this._names=_names;
|
||||
this._restriction_args=_restriction_args;
|
||||
source_context = sc;
|
||||
FillParentsInDirectChilds();
|
||||
}
|
||||
protected template_param_list _restriction_args;
|
||||
|
||||
///<summary>
|
||||
///
|
||||
///</summary>
|
||||
public template_param_list restriction_args
|
||||
{
|
||||
get
|
||||
{
|
||||
return _restriction_args;
|
||||
}
|
||||
set
|
||||
{
|
||||
_restriction_args=value;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/// <summary> Создает копию узла </summary>
|
||||
public override syntax_tree_node Clone()
|
||||
{
|
||||
typeclass_reference copy = new typeclass_reference();
|
||||
copy.Parent = this.Parent;
|
||||
if (source_context != null)
|
||||
copy.source_context = new SourceContext(source_context);
|
||||
if (attributes != null)
|
||||
{
|
||||
copy.attributes = (attribute_list)attributes.Clone();
|
||||
copy.attributes.Parent = copy;
|
||||
}
|
||||
if (attr_list != null)
|
||||
{
|
||||
copy.attr_list = (type_definition_attr_list)attr_list.Clone();
|
||||
copy.attr_list.Parent = copy;
|
||||
}
|
||||
if (names != null)
|
||||
{
|
||||
foreach (ident elem in names)
|
||||
{
|
||||
if (elem != null)
|
||||
{
|
||||
copy.Add((ident)elem.Clone());
|
||||
copy.Last().Parent = copy;
|
||||
}
|
||||
else
|
||||
copy.Add(null);
|
||||
}
|
||||
}
|
||||
if (restriction_args != null)
|
||||
{
|
||||
copy.restriction_args = (template_param_list)restriction_args.Clone();
|
||||
copy.restriction_args.Parent = copy;
|
||||
}
|
||||
return copy;
|
||||
}
|
||||
|
||||
/// <summary> Получает копию данного узла корректного типа </summary>
|
||||
public new typeclass_reference TypedClone()
|
||||
{
|
||||
return Clone() as typeclass_reference;
|
||||
}
|
||||
|
||||
///<summary> Заполняет поля Parent в непосредственных дочерних узлах </summary>
|
||||
public override void FillParentsInDirectChilds()
|
||||
{
|
||||
if (attributes != null)
|
||||
attributes.Parent = this;
|
||||
if (attr_list != null)
|
||||
attr_list.Parent = this;
|
||||
if (names != null)
|
||||
{
|
||||
foreach (var child in names)
|
||||
if (child != null)
|
||||
child.Parent = this;
|
||||
}
|
||||
if (restriction_args != null)
|
||||
restriction_args.Parent = this;
|
||||
}
|
||||
|
||||
///<summary> Заполняет поля Parent во всем поддереве </summary>
|
||||
public override void FillParentsInAllChilds()
|
||||
{
|
||||
FillParentsInDirectChilds();
|
||||
attributes?.FillParentsInAllChilds();
|
||||
attr_list?.FillParentsInAllChilds();
|
||||
if (names != null)
|
||||
{
|
||||
foreach (var child in names)
|
||||
child?.FillParentsInAllChilds();
|
||||
}
|
||||
restriction_args?.FillParentsInAllChilds();
|
||||
}
|
||||
|
||||
///<summary>
|
||||
///Свойство для получения количества всех подузлов без элементов поля типа List
|
||||
///</summary>
|
||||
public override Int32 subnodes_without_list_elements_count
|
||||
{
|
||||
get
|
||||
{
|
||||
return 2;
|
||||
}
|
||||
}
|
||||
///<summary>
|
||||
///Свойство для получения количества всех подузлов. Подузлом также считается каждый элемент поля типа List
|
||||
///</summary>
|
||||
public override Int32 subnodes_count
|
||||
{
|
||||
get
|
||||
{
|
||||
return 2 + (names == null ? 0 : names.Count);
|
||||
}
|
||||
}
|
||||
///<summary>
|
||||
///Индексатор для получения всех подузлов
|
||||
///</summary>
|
||||
public override syntax_tree_node this[Int32 ind]
|
||||
{
|
||||
get
|
||||
{
|
||||
if(subnodes_count == 0 || ind < 0 || ind > subnodes_count-1)
|
||||
throw new IndexOutOfRangeException();
|
||||
switch(ind)
|
||||
{
|
||||
case 0:
|
||||
return attr_list;
|
||||
case 1:
|
||||
return restriction_args;
|
||||
}
|
||||
Int32 index_counter=ind - 2;
|
||||
if(names != null)
|
||||
{
|
||||
if(index_counter < names.Count)
|
||||
{
|
||||
return names[index_counter];
|
||||
}
|
||||
}
|
||||
return null;
|
||||
}
|
||||
set
|
||||
{
|
||||
if(subnodes_count == 0 || ind < 0 || ind > subnodes_count-1)
|
||||
throw new IndexOutOfRangeException();
|
||||
switch(ind)
|
||||
{
|
||||
case 0:
|
||||
attr_list = (type_definition_attr_list)value;
|
||||
break;
|
||||
case 1:
|
||||
restriction_args = (template_param_list)value;
|
||||
break;
|
||||
}
|
||||
Int32 index_counter=ind - 2;
|
||||
if(names != null)
|
||||
{
|
||||
if(index_counter < names.Count)
|
||||
{
|
||||
names[index_counter]= (ident)value;
|
||||
return;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
///<summary>
|
||||
///Метод для обхода дерева посетителем
|
||||
///</summary>
|
||||
///<param name="visitor">Объект-посетитель.</param>
|
||||
///<returns>Return value is void</returns>
|
||||
public override void visit(IVisitor visitor)
|
||||
{
|
||||
visitor.visit(this);
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -1366,6 +1366,12 @@ namespace PascalABCCompiler.SyntaxTree
|
|||
///<param name="_typeclass_param_list">Node to visit</param>
|
||||
///<returns> Return value is void </returns>
|
||||
void visit(typeclass_param_list _typeclass_param_list);
|
||||
///<summary>
|
||||
///Method to visit typeclass_reference.
|
||||
///</summary>
|
||||
///<param name="_typeclass_reference">Node to visit</param>
|
||||
///<returns> Return value is void </returns>
|
||||
void visit(typeclass_reference _typeclass_reference);
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -2940,6 +2940,22 @@
|
|||
</TagIndices>
|
||||
</Tags>
|
||||
</SyntaxNode>
|
||||
<SyntaxNode Name="typeclass_reference" BaseName="named_type_reference">
|
||||
<Fields>
|
||||
<SyntaxField Name="restriction_args" SyntaxType="template_param_list" />
|
||||
</Fields>
|
||||
<Methods />
|
||||
<Tags>
|
||||
<CategoryIndices>
|
||||
<CategoryIndex>0</CategoryIndex>
|
||||
<CategoryIndex>0</CategoryIndex>
|
||||
</CategoryIndices>
|
||||
<TagIndices>
|
||||
<TagIndex>9</TagIndex>
|
||||
<TagIndex>4</TagIndex>
|
||||
</TagIndices>
|
||||
</Tags>
|
||||
</SyntaxNode>
|
||||
</SyntaxNodes>
|
||||
<Settings>
|
||||
<FileName>Tree.cs</FileName>
|
||||
|
|
@ -2960,12 +2976,12 @@
|
|||
<Tag Name="Выражения" ReferenceCount="36" />
|
||||
<Tag Name="Константы" ReferenceCount="15" />
|
||||
<Tag Name="Списки" ReferenceCount="23" />
|
||||
<Tag Name="Типы" ReferenceCount="14" />
|
||||
<Tag Name="Типы" ReferenceCount="15" />
|
||||
<Tag Name="Описания" ReferenceCount="25" />
|
||||
<Tag Name="Важнейшие" ReferenceCount="207" />
|
||||
<Tag Name="Method_Procedure_Call" ReferenceCount="2" />
|
||||
<Tag Name="Yield" ReferenceCount="8" />
|
||||
<Tag Name="Typeclasses" ReferenceCount="6" />
|
||||
<Tag Name="Typeclasses" ReferenceCount="7" />
|
||||
</Tags>
|
||||
</FilterCategory>
|
||||
</TagCategories>
|
||||
|
|
@ -4162,6 +4178,9 @@
|
|||
<HelpData Key="typeclass_param_list" Value="Список параметров тайпкласса" />
|
||||
<HelpData Key="typeclass_param_list.public typeclass_param_list(template_param_list _template_param_list): this(_template_param_list._dereferencing_value, _template_param_list._params_list, _template_param_list.source_context)" Value="" />
|
||||
<HelpData Key="typeclass_param_list.public typeclass_param_list(template_param_list _template_param_list): this(_template_param_list.dereferencing_value, _template_param_list.params_list, _template_param_list.source_context)" Value="" />
|
||||
<HelpData Key="typeclass_param_list.public typeclass_param_list(template_param_list _template_param_list): this(_template_param_list.dereferencing_value, _template_param_list.params_list, _template_param_list.source_context)
{
}" Value="" />
|
||||
<HelpData Key="typeclass_reference" Value="" />
|
||||
<HelpData Key="typeclass_reference.restriction_args" Value="" />
|
||||
<HelpData Key="typeclass_restriction" Value="Представляет конструкцию вида Typeclass[T], где Typleclass это ограничение, которое накладывается на тип T" />
|
||||
<HelpData Key="typeclass_restriction.restriction_args" Value="" />
|
||||
<HelpData Key="typed_const_definition" Value="" />
|
||||
|
|
|
|||
|
|
@ -31,6 +31,8 @@ namespace PascalABCCompiler.SyntaxTreeConverters
|
|||
instancesAndRestrictedFunctions.ProcessNode(root);
|
||||
SyntaxVisitors.TypeclassVisitors.ReplaceTypeclassVisitor.New(instancesAndRestrictedFunctions).ProcessNode(root);
|
||||
}
|
||||
root.FillParentsInAllChilds();
|
||||
new SimplePrettyPrinterVisitor("E:/projs/out.txt").ProcessNode(root);
|
||||
// loop
|
||||
LoopDesugarVisitor.New.ProcessNode(root);
|
||||
|
||||
|
|
|
|||
|
|
@ -13,13 +13,13 @@ namespace SyntaxVisitors.TypeclassVisitors
|
|||
{
|
||||
|
||||
// (Typeclass name) -> (Type arguments count)
|
||||
public Dictionary<string, int> typeclasses;
|
||||
public Dictionary<string, type_declaration> typeclasses;
|
||||
// (Typeclass name) -> [Instances]
|
||||
public Dictionary<string, List<typeclass_param_list>> instances = new Dictionary<string, List<typeclass_param_list>>();
|
||||
public Dictionary<string, List<string>> restrictedFunctions = new Dictionary<string, List<string>>();
|
||||
|
||||
|
||||
public FindInstancesAndRestrictedFunctionsVisitor(Dictionary<string, int> typeclasses)
|
||||
public FindInstancesAndRestrictedFunctionsVisitor(Dictionary<string, type_declaration> typeclasses)
|
||||
{
|
||||
this.typeclasses = typeclasses;
|
||||
|
||||
|
|
@ -30,7 +30,7 @@ namespace SyntaxVisitors.TypeclassVisitors
|
|||
}
|
||||
|
||||
|
||||
public static FindInstancesAndRestrictedFunctionsVisitor New(Dictionary<string, int> typeclasses)
|
||||
public static FindInstancesAndRestrictedFunctionsVisitor New(Dictionary<string, type_declaration> typeclasses)
|
||||
{
|
||||
return new FindInstancesAndRestrictedFunctionsVisitor(typeclasses);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -14,7 +14,7 @@ namespace SyntaxVisitors.TypeclassVisitors
|
|||
//TODO: add searching typeclasses at libraries
|
||||
|
||||
// (Typeclass name) -> (Type arguments count)
|
||||
public Dictionary<string, int> typeclasses = new Dictionary<string, int>();
|
||||
public Dictionary<string, type_declaration> typeclasses = new Dictionary<string, type_declaration>();
|
||||
|
||||
|
||||
public FindTypeclassesVisitor()
|
||||
|
|
@ -42,7 +42,7 @@ namespace SyntaxVisitors.TypeclassVisitors
|
|||
|
||||
var typeclassName = typeclassDeclaration.type_name as typeclass_restriction;
|
||||
|
||||
typeclasses.Add(typeclassName.name, typeclassName.restriction_args.params_list.Count);
|
||||
typeclasses.Add(typeclassName.name, typeclassDeclaration);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -7,6 +7,7 @@ using PascalABCCompiler;
|
|||
using PascalABCCompiler.Errors;
|
||||
using PascalABCCompiler.SyntaxTree;
|
||||
|
||||
|
||||
namespace SyntaxVisitors.TypeclassVisitors
|
||||
{
|
||||
public class ReplaceTypeclassVisitor: BaseChangeVisitor
|
||||
|
|
@ -32,13 +33,44 @@ namespace SyntaxVisitors.TypeclassVisitors
|
|||
}
|
||||
var instanceName = instanceDeclaration.type_name as typeclass_restriction;
|
||||
|
||||
var parents = new named_type_reference_list(new template_type_reference(
|
||||
instanceName.name, instanceName.restriction_args));
|
||||
// If it is instance of derived typelass than it should have template parameters
|
||||
var templateArgs = new ident_list();
|
||||
where_definition_list whereSection = null;
|
||||
var typeclassParents = (instancesAndRestrictedFunctions.typeclasses[instanceName.name].type_def as typeclass_definition).additional_restrictions;
|
||||
if (typeclassParents != null && typeclassParents.Count > 0)
|
||||
{
|
||||
whereSection = new where_definition_list();
|
||||
|
||||
for (int i = 0; i < typeclassParents.Count; i++)
|
||||
{
|
||||
ident template_name;
|
||||
if (typeclassParents[i] is typeclass_reference tr)
|
||||
{
|
||||
string name = tr.names[0].name;
|
||||
template_name = TypeclassRestrctionToTemplateName(name, tr.restriction_args);
|
||||
|
||||
whereSection.Add(GetWhereRestriction(
|
||||
TypeclassReferenceToInterfaceName(name, instanceName.restriction_args),
|
||||
template_name));
|
||||
}
|
||||
else
|
||||
{
|
||||
throw new NotImplementedException("Should be syntactic error");
|
||||
}
|
||||
templateArgs.Add(template_name);
|
||||
}
|
||||
}
|
||||
|
||||
List<type_definition> templateLists = instanceName.restriction_args.params_list.Concat(templateArgs.idents.Select(x => new named_type_reference(x.name)).OfType<type_definition>()).ToList();
|
||||
var parents = new named_type_reference_list(new List<named_type_reference> {
|
||||
new template_type_reference(instanceName.name, new template_param_list(templateLists)),
|
||||
new template_type_reference("I" + instanceName.name, instanceName.restriction_args)});
|
||||
var instanceDefTranslated =
|
||||
SyntaxTreeBuilder.BuildClassDefinition(
|
||||
parents,
|
||||
null, instanceDefinition.body.class_def_blocks.ToArray());
|
||||
|
||||
instanceDefTranslated.template_args = templateArgs;
|
||||
instanceDefTranslated.where_section = whereSection;
|
||||
|
||||
for (int i = 0; i < instanceDefTranslated.body.class_def_blocks.Count; i++)
|
||||
{
|
||||
|
|
@ -50,7 +82,7 @@ namespace SyntaxVisitors.TypeclassVisitors
|
|||
(cm[j] as procedure_definition)?.proc_header.proc_attributes.Add(new procedure_attribute("override", proc_attribute.attr_override));
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
{
|
||||
// Add constructor
|
||||
var cm = instanceDefTranslated.body.class_def_blocks[0];
|
||||
|
|
@ -62,12 +94,10 @@ namespace SyntaxVisitors.TypeclassVisitors
|
|||
|
||||
cm.Add(def);
|
||||
}
|
||||
|
||||
*/
|
||||
var typeName = CreateInstanceName(instanceName.restriction_args as typeclass_param_list, instanceName.name);
|
||||
|
||||
var typeclassNameTanslated = new ident(typeName);
|
||||
|
||||
var instanceDeclTranslated = new type_declaration(typeclassNameTanslated, instanceDefTranslated, instanceDeclaration.source_context);
|
||||
var instanceDeclTranslated = new type_declaration(new ident(typeName), instanceDefTranslated, instanceDeclaration.source_context);
|
||||
Replace(instanceDeclaration, instanceDeclTranslated);
|
||||
visit(instanceDeclTranslated);
|
||||
|
||||
|
|
@ -96,9 +126,59 @@ namespace SyntaxVisitors.TypeclassVisitors
|
|||
|
||||
// TODO: typeclassDefinition.additional_restrictions - translate to usual classes
|
||||
|
||||
// Creating interface
|
||||
|
||||
// Get members for typeclass interface
|
||||
var interfaceMembers = new List<class_members>();
|
||||
foreach (var cm in typeclassDefinition.body.class_def_blocks)
|
||||
{
|
||||
var cmNew = (class_members)cm.Clone();
|
||||
|
||||
for (int i = 0; i < cmNew.members.Count; i++)
|
||||
{
|
||||
var member = cmNew.members[i];
|
||||
if (member is function_header || member is procedure_header)
|
||||
{
|
||||
continue;
|
||||
}
|
||||
else if (member is procedure_definition procDef)
|
||||
{
|
||||
cmNew.members[i] = procDef.proc_header;
|
||||
}
|
||||
}
|
||||
|
||||
interfaceMembers.Add(cmNew);
|
||||
}
|
||||
var interfaceInheritance = (named_type_reference_list)typeclassDefinition.additional_restrictions?.Clone();
|
||||
if (interfaceInheritance != null)
|
||||
{
|
||||
interfaceInheritance.source_context = null;
|
||||
for (int i = 0; i < interfaceInheritance.types.Count; i++)
|
||||
{
|
||||
if (interfaceInheritance.types[i] is typeclass_reference tr)
|
||||
{
|
||||
interfaceInheritance.types[i] = TypeclassReferenceToInterfaceName(tr.names[0].name, tr.restriction_args);
|
||||
}
|
||||
else
|
||||
{
|
||||
throw new NotImplementedException("Syntactic Error");
|
||||
}
|
||||
}
|
||||
}
|
||||
var typeclassInterfaceDef =
|
||||
SyntaxTreeBuilder.BuildClassDefinition(
|
||||
interfaceInheritance,
|
||||
null, interfaceMembers.ToArray());
|
||||
typeclassInterfaceDef.keyword = class_keyword.Interface;
|
||||
var typeclassInterfaceName = new template_type_name("I" + typeclassName.name, RestrictionsToIdentList(typeclassName.restriction_args));
|
||||
var typeclassInterfaceDecl = new type_declaration(typeclassInterfaceName, typeclassInterfaceDef);
|
||||
|
||||
|
||||
// Creating class
|
||||
|
||||
var typeclassDefTranslated =
|
||||
SyntaxTreeBuilder.BuildClassDefinition(
|
||||
typeclassDefinition.additional_restrictions,
|
||||
new named_type_reference_list(new template_type_reference(typeclassInterfaceName.name, typeclassName.restriction_args)),
|
||||
null, typeclassDefinition.body.class_def_blocks.ToArray());
|
||||
|
||||
typeclassDefTranslated.attribute = class_attribute.Abstract;
|
||||
|
|
@ -112,7 +192,7 @@ namespace SyntaxVisitors.TypeclassVisitors
|
|||
(cm[j] as procedure_definition)?.proc_header.proc_attributes.Add(new procedure_attribute("virtual", proc_attribute.attr_virtual));
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
{
|
||||
// Add constructor
|
||||
var cm = typeclassDefTranslated.body.class_def_blocks[0];
|
||||
|
|
@ -124,18 +204,105 @@ namespace SyntaxVisitors.TypeclassVisitors
|
|||
|
||||
cm.Add(def);
|
||||
}
|
||||
|
||||
*/
|
||||
// Add template parameters for typeclass class(derived typeclasses)
|
||||
ident_list templates = RestrictionsToIdentList(typeclassName.restriction_args);
|
||||
if (typeclassDefinition.additional_restrictions != null)
|
||||
{
|
||||
for (int i = 0; i < typeclassDefinition.additional_restrictions.types.Count; i++)
|
||||
{
|
||||
string name;
|
||||
string templateName;
|
||||
if (typeclassDefinition.additional_restrictions.types[i] is typeclass_reference tr)
|
||||
{
|
||||
name = tr.names[0].name;
|
||||
templateName = TypeclassRestrctionToTemplateName(name, tr.restriction_args).name;
|
||||
}
|
||||
else
|
||||
{
|
||||
throw new NotImplementedException("SyntaxError");
|
||||
}
|
||||
|
||||
// Add template parameter
|
||||
templates.Add(templateName);
|
||||
|
||||
// Add where restriction
|
||||
if (typeclassDefTranslated.where_section == null)
|
||||
{
|
||||
typeclassDefTranslated.where_section = new where_definition_list();
|
||||
}
|
||||
typeclassDefTranslated.where_section.Add(GetWhereRestriction(
|
||||
interfaceInheritance.types[i],
|
||||
templateName));
|
||||
|
||||
// Add methods from derived typeclasses
|
||||
var body = (instancesAndRestrictedFunctions.typeclasses[name].type_def as typeclass_definition).body;
|
||||
foreach (var cdb in body.class_def_blocks)
|
||||
{
|
||||
var cdbNew = new class_members(cdb.access_mod == null ? access_modifer.none : cdb.access_mod.access_level);
|
||||
foreach (var member in cdb.members)
|
||||
{
|
||||
procedure_header memberHeaderNew;
|
||||
|
||||
if (member is procedure_header || member is function_header)
|
||||
{
|
||||
memberHeaderNew = (procedure_header)member.Clone();
|
||||
memberHeaderNew.source_context = null;
|
||||
}
|
||||
else if (member is procedure_definition procDefinition)
|
||||
{
|
||||
memberHeaderNew = (procedure_header)procDefinition.proc_header.Clone();
|
||||
memberHeaderNew.Parent = null;
|
||||
memberHeaderNew.source_context = null;
|
||||
}
|
||||
else
|
||||
{
|
||||
continue;
|
||||
}
|
||||
|
||||
var variableName = templateName + "Instance";
|
||||
var parameters = memberHeaderNew.parameters.params_list.Aggregate(new expression_list(), (x, y) => new expression_list(x.expressions.Concat(y.idents.idents).ToList()));
|
||||
var callName = new dot_node(variableName, memberHeaderNew.name.meth_name.name);
|
||||
var methodCall = new method_call(callName, parameters);
|
||||
statement exec = null;
|
||||
if (memberHeaderNew is function_header)
|
||||
{
|
||||
exec = new assign("Result", methodCall);
|
||||
}
|
||||
else if (memberHeaderNew is procedure_header)
|
||||
{
|
||||
exec = new procedure_call(methodCall);
|
||||
}
|
||||
var procDef = new procedure_definition(
|
||||
memberHeaderNew,
|
||||
new statement_list(
|
||||
GetInstanceSingleton(templateName),
|
||||
exec));
|
||||
cdbNew.Add(procDef);
|
||||
}
|
||||
typeclassDefTranslated.body.class_def_blocks.Add(cdbNew);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
var typeclassNameTanslated = new template_type_name(typeclassName.name, templates, typeclassName.source_context);
|
||||
|
||||
var typeclassDeclTranslated = new type_declaration(typeclassNameTanslated, typeclassDefTranslated, typeclassDeclaration.source_context);
|
||||
|
||||
Replace(typeclassDeclaration, typeclassDeclTranslated);
|
||||
UpperNodeAs<type_declarations>().InsertBefore(typeclassDeclTranslated, typeclassInterfaceDecl);
|
||||
visit(typeclassInterfaceDecl);
|
||||
visit(typeclassDeclTranslated);
|
||||
|
||||
return true;
|
||||
}
|
||||
|
||||
private static template_type_reference TypeclassReferenceToInterfaceName(string name, template_param_list restriction_args)
|
||||
{
|
||||
return new template_type_reference(
|
||||
new named_type_reference("I" + name), restriction_args);
|
||||
}
|
||||
|
||||
private static ident_list RestrictionsToIdentList(template_param_list restrictions)
|
||||
{
|
||||
var templates = new ident_list();
|
||||
|
|
@ -187,22 +354,15 @@ namespace SyntaxVisitors.TypeclassVisitors
|
|||
if (where is where_typeclass_constraint)
|
||||
{
|
||||
var typeclassWhere = where as where_typeclass_constraint;
|
||||
var newName = TypeclassRestrctionToTemplateName(typeclassWhere.restriction);
|
||||
var newName = TypeclassRestrctionToTemplateName(typeclassWhere.restriction.name, typeclassWhere.restriction.restriction_args);
|
||||
|
||||
additionalTemplateArgs.Add(newName);
|
||||
|
||||
// Create name for template that replaces typeclass(for ex. SumTC)
|
||||
headerTranslated.where_defs.defs.Add(
|
||||
// where
|
||||
new where_definition(
|
||||
// ConstraintTC :
|
||||
new ident_list(newName),
|
||||
new where_type_specificator_list(new List<type_definition> {
|
||||
// Constraint<T, C>,
|
||||
new template_type_reference(new named_type_reference(typeclassWhere.restriction.name), typeclassWhere.restriction.restriction_args),
|
||||
// constructor
|
||||
new declaration_specificator(DeclarationSpecificator.WhereDefConstructor, "constructor")
|
||||
})));
|
||||
GetWhereRestriction(
|
||||
new template_type_reference(new named_type_reference("I" + typeclassWhere.restriction.name), typeclassWhere.restriction.restriction_args),
|
||||
newName));
|
||||
}
|
||||
else
|
||||
{
|
||||
|
|
@ -217,12 +377,7 @@ namespace SyntaxVisitors.TypeclassVisitors
|
|||
var blockProc = (_procedure_definition.proc_body as block);
|
||||
foreach (var arg in additionalTemplateArgs.idents)
|
||||
{
|
||||
blockProc.program_code.AddFirst(new var_statement(new var_def_statement(
|
||||
arg.name + "Instance",
|
||||
new dot_node(
|
||||
new ident_with_templateparams(new ident("__ConceptSingleton"), new template_param_list(new List<type_definition> { new named_type_reference((ident)arg.Clone()) })),
|
||||
new ident("Instance")
|
||||
))));
|
||||
blockProc.program_code.AddFirst(GetInstanceSingleton(arg.name));
|
||||
}
|
||||
|
||||
//var list = _procedure_definition.proc_body.DescendantNodes().OfType<typeclass_param_list>();
|
||||
|
|
@ -251,6 +406,30 @@ namespace SyntaxVisitors.TypeclassVisitors
|
|||
Replace(_procedure_definition, procedureDefTranslated);
|
||||
}
|
||||
|
||||
private static var_statement GetInstanceSingleton(string typeName)
|
||||
{
|
||||
return new var_statement(new var_def_statement(
|
||||
typeName + "Instance",
|
||||
new dot_node(
|
||||
new ident_with_templateparams(new ident("__ConceptSingleton"), new template_param_list(new List<type_definition> { new named_type_reference(typeName) })),
|
||||
new ident("Instance")
|
||||
)));
|
||||
}
|
||||
|
||||
private static where_definition GetWhereRestriction(type_definition restriction, ident templateName)
|
||||
{
|
||||
return // where
|
||||
new where_definition(
|
||||
// ConstraintTC :
|
||||
new ident_list(templateName),
|
||||
new where_type_specificator_list(new List<type_definition> {
|
||||
// IConstraint<T, C>,
|
||||
restriction,
|
||||
// constructor
|
||||
new declaration_specificator(DeclarationSpecificator.WhereDefConstructor, "constructor")
|
||||
}));
|
||||
}
|
||||
|
||||
public override void visit(method_call methodCall)
|
||||
{
|
||||
var methodName = methodCall.dereferencing_value as ident_with_templateparams;
|
||||
|
|
@ -272,9 +451,22 @@ namespace SyntaxVisitors.TypeclassVisitors
|
|||
// TODO: Add template types for typeclass instances
|
||||
var methodStrName = (methodName.name as ident).name;
|
||||
var typeclasses = instancesAndRestrictedFunctions.restrictedFunctions[methodStrName];
|
||||
|
||||
var possibleOverloadingsForEachTypeclass = typeclasses.Select(x =>
|
||||
new KeyValuePair<string, List<typeclass_param_list>>(x, instancesAndRestrictedFunctions.instances[x]));
|
||||
|
||||
List<type_definition> newParams = GetTranslatedTypeclassParameters(paramList, typeclasses);
|
||||
|
||||
paramList.AddRange(newParams);
|
||||
|
||||
var methodCallTranslated = new method_call(
|
||||
new ident_with_templateparams(methodName.name, new template_param_list(paramList), methodName.source_context),
|
||||
methodCall.parameters,
|
||||
methodCall.source_context);
|
||||
Replace(methodCall, methodCallTranslated);
|
||||
}
|
||||
|
||||
private List<type_definition> GetTranslatedTypeclassParameters(List<type_definition> paramList, IEnumerable<string> typeclasses)
|
||||
{
|
||||
var possibleOverloadingsForEachTypeclass = typeclasses.Select(x =>
|
||||
new KeyValuePair<string, List<typeclass_param_list>>(x, instancesAndRestrictedFunctions.instances[x]));
|
||||
|
||||
// Find current overloading in possible
|
||||
var newParams = new List<type_definition>();
|
||||
|
|
@ -292,36 +484,48 @@ namespace SyntaxVisitors.TypeclassVisitors
|
|||
break;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
// TODO: need many checks
|
||||
// Typeclass params and function restriction params are mixed up
|
||||
// Fix it as soon as it possible
|
||||
// Btw for 1 argument it's ok.
|
||||
if (isEqual)
|
||||
{
|
||||
newParams.Add(new named_type_reference(CreateInstanceName(possibleParamList, typeclassOverloadings.Key)));
|
||||
var derived_typeclass =
|
||||
(instancesAndRestrictedFunctions.typeclasses[typeclassOverloadings.Key].type_def as typeclass_definition);
|
||||
|
||||
var base_typeclasses = derived_typeclass.additional_restrictions?.types.OfType<typeclass_reference>().Select(x => x.names[0].name);
|
||||
var typeName = new named_type_reference(CreateInstanceName(possibleParamList, typeclassOverloadings.Key));
|
||||
if (base_typeclasses == null || base_typeclasses.Count() == 0)
|
||||
{
|
||||
newParams.Add(typeName);
|
||||
|
||||
}
|
||||
else
|
||||
{
|
||||
var translatedParams = GetTranslatedTypeclassParameters(paramList, base_typeclasses);
|
||||
|
||||
newParams.Add(new template_type_reference(
|
||||
typeName,
|
||||
new template_param_list(translatedParams)));
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
paramList.AddRange(newParams);
|
||||
|
||||
var methodCallTranslated = new method_call(
|
||||
new ident_with_templateparams(methodName.name, new template_param_list(paramList), methodName.source_context),
|
||||
methodCall.parameters,
|
||||
methodCall.source_context);
|
||||
Replace(methodCall, methodCallTranslated);
|
||||
return newParams;
|
||||
}
|
||||
|
||||
private static ident TypeclassRestrctionToTemplateName(typeclass_restriction typeclassWhere)
|
||||
private static ident TypeclassRestrctionToTemplateName(string name, template_param_list restriction_args)
|
||||
{
|
||||
|
||||
// Concatenate type constraint into new type name
|
||||
// For example:
|
||||
// Constaint[T, C] => ConstraintTC
|
||||
return RestrictionsToIdentList(typeclassWhere.restriction_args).idents.Aggregate(
|
||||
new ident(typeclassWhere.name), (x, y) => x.name + y.name);
|
||||
return RestrictionsToIdentList(restriction_args).idents.Aggregate(
|
||||
new ident(name), (x, y) => x.name + y.name);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue