diff --git a/CodeExamples/TypeclassExample.pas b/CodeExamples/TypeclassExample.pas index b1a637bad..b8559b35e 100644 --- a/CodeExamples/TypeclassExample.pas +++ b/CodeExamples/TypeclassExample.pas @@ -12,11 +12,14 @@ function Sum3(v1, v2, v3: T): T; where SumTC[T]; begin - Result := SumTC[T].sum(v1, SumTC[T].sum(v2, v3)); + Result := SumTC&[T].sum(v1, SumTC&[T].sum(v2, v3)); end; begin var v1, v2, v3, res: integer; + v1 := 1; + v2 := 2; + v3 := 3; res := Sum3&[integer](v1, v2, v3); diff --git a/CodeExamples/TypeclassTranslation.pas b/CodeExamples/TypeclassTranslation.pas index 1fb28e2a1..918c4a7a5 100644 --- a/CodeExamples/TypeclassTranslation.pas +++ b/CodeExamples/TypeclassTranslation.pas @@ -6,19 +6,14 @@ ExplicitModelAttribute = class(System.Attribute) end; -(* [Concept] SumTC = abstract class public constructor; begin end; function sum(v1, v2: T): T; abstract; - end;*) - SumTC[T] = typeclass - function sum(v1, v2: T): T; end; -(* SumTC_Integer = class(SumTC) public constructor(); @@ -29,41 +24,15 @@ begin Result := v1 + v2; end; - end;*) - SumTC[integer] = instance - function sum(v1, v2: integer): integer; - begin - Result := v1 + v2; - end; end; -(* - ConceptSingleton = class where T: constructor; - class _instance: T; - class inited: boolean := false; - public - class function &Instance: T; - begin - if inited = false then - begin - inited := true; - _instance := new T; - end; - - Result := _instance; - end; - end;*) -(* + function Sum3(v1, v2, v3: T): T; where SumTCT: SumTC, constructor; begin - var s := ConceptSingleton&.&Instance; + var s := __ConceptSingleton&.&Instance; Result := s.sum(v1, s.sum(v2, v3)); end; -*) -function Sum3(v1, v2, v3: T): T; where SumTC[T]; -begin - Result := SumTC&[T].sum(v1, SumTC&[T].sum(v2, v3)); -end; + begin write(Sum3&(1, 2, 3)); diff --git a/SyntaxTreeConverters/StandardSyntaxConverter.cs b/SyntaxTreeConverters/StandardSyntaxConverter.cs index f046844b8..0fd484011 100644 --- a/SyntaxTreeConverters/StandardSyntaxConverter.cs +++ b/SyntaxTreeConverters/StandardSyntaxConverter.cs @@ -24,8 +24,13 @@ namespace PascalABCCompiler.SyntaxTreeConverters //--- Обработка синтаксически сахарных узлов - SyntaxVisitors.TypeclassVisitors.ReplaceTypeclassVisitor.New.ProcessNode(root); - + { + var typeclasses = SyntaxVisitors.TypeclassVisitors.FindTypeclassesVisitor.New; + typeclasses.ProcessNode(root); + var instancesAndRestrictedFunctions = SyntaxVisitors.TypeclassVisitors.FindInstancesAndRestrictedFunctionsVisitor.New(typeclasses.typeclasses); + instancesAndRestrictedFunctions.ProcessNode(root); + SyntaxVisitors.TypeclassVisitors.ReplaceTypeclassVisitor.New(instancesAndRestrictedFunctions).ProcessNode(root); + } // loop LoopDesugarVisitor.New.ProcessNode(root); diff --git a/SyntaxVisitors/SyntaxVisitors.csproj b/SyntaxVisitors/SyntaxVisitors.csproj index 04db87d61..32d4f5c4c 100644 --- a/SyntaxVisitors/SyntaxVisitors.csproj +++ b/SyntaxVisitors/SyntaxVisitors.csproj @@ -57,7 +57,7 @@ - + diff --git a/SyntaxVisitors/TypeclassVisitors/FindInstancesAndRestrictedFunctionsVisitor.cs b/SyntaxVisitors/TypeclassVisitors/FindInstancesAndRestrictedFunctionsVisitor.cs new file mode 100644 index 000000000..49c5de87e --- /dev/null +++ b/SyntaxVisitors/TypeclassVisitors/FindInstancesAndRestrictedFunctionsVisitor.cs @@ -0,0 +1,67 @@ +using System; +using System.Collections.Generic; +using System.Linq; +using System.Text; + +using PascalABCCompiler; +using PascalABCCompiler.Errors; +using PascalABCCompiler.SyntaxTree; + +namespace SyntaxVisitors.TypeclassVisitors +{ + public class FindInstancesAndRestrictedFunctionsVisitor: WalkingVisitorNew + { + + // (Typeclass name) -> (Type arguments count) + public Dictionary typeclasses; + // (Typeclass name) -> [Instances] + public Dictionary> instances = new Dictionary>(); + public Dictionary> restrictedFunctions = new Dictionary>(); + + + public FindInstancesAndRestrictedFunctionsVisitor(Dictionary typeclasses) + { + this.typeclasses = typeclasses; + + foreach (var typeclass in typeclasses) + { + instances.Add(typeclass.Key, new List()); + } + } + + + public static FindInstancesAndRestrictedFunctionsVisitor New(Dictionary typeclasses) + { + return new FindInstancesAndRestrictedFunctionsVisitor(typeclasses); + } + + + public override void visit(type_declaration instanceDeclaration) + { + var instanceDefinition = instanceDeclaration.type_def as instance_definition; + if (instanceDefinition == null) + { + return; + } + var instanceName = instanceDeclaration.type_name as typeclass_restriction; + + instances[instanceName.name].Add(instanceName.restriction_args as typeclass_param_list); + } + + + public override void visit(procedure_definition procedureDefinition) + { + bool isConstrainted = procedureDefinition.proc_header.where_defs != null && + procedureDefinition.proc_header.where_defs.defs.Any(x => x is where_typeclass_constraint); + if (!isConstrainted) + return; + + var usedTypeclasses = procedureDefinition.proc_header.where_defs. + defs.OfType() + .Select(x => x.restriction.name).ToList(); + + restrictedFunctions.Add(procedureDefinition.proc_header.name.meth_name.name, + usedTypeclasses); + } + } +} diff --git a/SyntaxVisitors/TypeclassVisitors/FindInstancesVisitor.cs b/SyntaxVisitors/TypeclassVisitors/FindInstancesVisitor.cs deleted file mode 100644 index 05abf2b12..000000000 --- a/SyntaxVisitors/TypeclassVisitors/FindInstancesVisitor.cs +++ /dev/null @@ -1,50 +0,0 @@ -using System; -using System.Collections.Generic; -using System.Linq; -using System.Text; - -using PascalABCCompiler; -using PascalABCCompiler.Errors; -using PascalABCCompiler.SyntaxTree; - -namespace SyntaxVisitors.TypeclassVisitors -{ - public class FindInstancesVisitor: WalkingVisitorNew - { - - // (Typeclass name) -> (Type arguments count) - Dictionary typeclasses; - // (Typeclass name) -> [Instances] - Dictionary> instances = new Dictionary>(); - - - public FindInstancesVisitor(Dictionary typeclasses) - { - this.typeclasses = typeclasses; - - foreach (var typeclass in typeclasses) - { - instances.Add(typeclass.Key, new HashSet()); - } - } - - - public static FindInstancesVisitor New(Dictionary typeclasses) - { - return new FindInstancesVisitor(typeclasses); - } - - - public override void visit(type_declaration instanceDeclaration) - { - var instanceDefinition = instanceDeclaration.type_def as instance_definition; - if (instanceDefinition == null) - { - return; - } - var instanceName = instanceDeclaration.type_name as typeclass_restriction; - - instances[instanceName.name].Add(instanceName.restriction_args); - } - } -} diff --git a/SyntaxVisitors/TypeclassVisitors/FindTypeclassesVisitor.cs b/SyntaxVisitors/TypeclassVisitors/FindTypeclassesVisitor.cs index 05918632b..6b502db64 100644 --- a/SyntaxVisitors/TypeclassVisitors/FindTypeclassesVisitor.cs +++ b/SyntaxVisitors/TypeclassVisitors/FindTypeclassesVisitor.cs @@ -14,7 +14,7 @@ namespace SyntaxVisitors.TypeclassVisitors //TODO: add searching typeclasses at libraries // (Typeclass name) -> (Type arguments count) - Dictionary typeclasses = new Dictionary(); + public Dictionary typeclasses = new Dictionary(); public FindTypeclassesVisitor() diff --git a/SyntaxVisitors/TypeclassVisitors/ReplaceTypeclassVisitor.cs b/SyntaxVisitors/TypeclassVisitors/ReplaceTypeclassVisitor.cs index c5903a240..8843612da 100644 --- a/SyntaxVisitors/TypeclassVisitors/ReplaceTypeclassVisitor.cs +++ b/SyntaxVisitors/TypeclassVisitors/ReplaceTypeclassVisitor.cs @@ -11,17 +11,16 @@ namespace SyntaxVisitors.TypeclassVisitors { public class ReplaceTypeclassVisitor: BaseChangeVisitor { - public ReplaceTypeclassVisitor() - { + FindInstancesAndRestrictedFunctionsVisitor instancesAndRestrictedFunctions; + public ReplaceTypeclassVisitor(FindInstancesAndRestrictedFunctionsVisitor instancesAndRestrictedFunctions) + { + this.instancesAndRestrictedFunctions = instancesAndRestrictedFunctions; } - public static ReplaceTypeclassVisitor New + public static ReplaceTypeclassVisitor New(FindInstancesAndRestrictedFunctionsVisitor instancesAndRestrictedFunctions) { - get - { - return new ReplaceTypeclassVisitor(); - } + return new ReplaceTypeclassVisitor(instancesAndRestrictedFunctions); } bool VisitInstanceDeclaration(type_declaration instanceDeclaration) @@ -65,12 +64,8 @@ namespace SyntaxVisitors.TypeclassVisitors cm.Add(def); } - string typeName = instanceName.name; - for (int i = 0; i < instanceName.restriction_args.Count; i++) - { - typeName += "_" + (instanceName.restriction_args.params_list[i] as named_type_reference).names[0]; - } - + 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); @@ -80,6 +75,15 @@ namespace SyntaxVisitors.TypeclassVisitors return true; } + private static string CreateInstanceName(typeclass_param_list restriction_args, string typeName) + { + for (int i = 0; i < restriction_args.Count; i++) + { + typeName += "_" + (restriction_args.params_list[i] as named_type_reference).names[0]; + } + + return typeName; + } bool VisitTypeclassDeclaration(type_declaration typeclassDeclaration) { @@ -156,6 +160,8 @@ namespace SyntaxVisitors.TypeclassVisitors { return; } + + DefaultVisit(_type_declaration); } @@ -164,7 +170,10 @@ namespace SyntaxVisitors.TypeclassVisitors bool isConstrainted = _procedure_definition.proc_header.where_defs != null && _procedure_definition.proc_header.where_defs.defs.Any(x => x is where_typeclass_constraint); if (!isConstrainted) + { + DefaultVisit(_procedure_definition); return; + } var header = _procedure_definition.proc_header; var headerTranslated = header.Clone() as procedure_header; @@ -246,20 +255,63 @@ namespace SyntaxVisitors.TypeclassVisitors { var methodName = methodCall.dereferencing_value as ident_with_templateparams; if (methodName == null) + { + DefaultVisit(methodCall); return; + } var typeclassRestrictions = methodName.template_params as typeclass_param_list; if (typeclassRestrictions == null) + { + DefaultVisit(methodCall); return; + } var paramList = new List(); paramList.AddRange(typeclassRestrictions.params_list); // 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>(x, instancesAndRestrictedFunctions.instances[x])); + + // Find current overloading in possible + var newParams = new List(); + foreach (var typeclassOverloadings in possibleOverloadingsForEachTypeclass) + { + foreach (var possibleParamList in typeclassOverloadings.Value) + { + bool isEqual = true; + for (int i = 0; i < possibleParamList.params_list.Count; i++) + { + if ((possibleParamList.params_list[i] as named_type_reference).names[0].name != + (paramList[i] as named_type_reference).names[0].name) + { + isEqual = false; + 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))); + } + + } + } + + 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 static ident TypeclassRestrctionToTemplateName(typeclass_restriction typeclassWhere)