From 4c2fb8fefbdec1856e160dc24b6498aa4bd5eb48 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Hannu=20Niemist=C3=B6?= Date: Wed, 1 Nov 2017 09:11:18 +0200 Subject: [PATCH] (refs #7588) Support for existential type variables with syntax ?v Change-Id: I418a9d260c02c7082e7a7359b90659ea2c3a96d4 --- .../contexts/TypeTranslationContext.java | 15 ++++++++++++ .../internal/parsing/types/TVarAst.java | 6 +++++ .../types/TypeElaborationContext.java | 21 ++++++++++++---- .../compiler/internal/types/ast/TVarAst.java | 2 +- .../simantics/scl/compiler/types/Types.java | 8 ------- .../scl/compiler/tests/InitialRepository.java | 13 ++++++++++ .../experimentation/TestExistential.java | 24 +++++++++++++++++++ 7 files changed, 76 insertions(+), 13 deletions(-) create mode 100644 tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/experimentation/TestExistential.java diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/contexts/TypeTranslationContext.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/contexts/TypeTranslationContext.java index 1eea959fd..d107cb621 100644 --- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/contexts/TypeTranslationContext.java +++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/contexts/TypeTranslationContext.java @@ -6,6 +6,7 @@ import org.simantics.scl.compiler.errors.ErrorLog; import org.simantics.scl.compiler.internal.parsing.exceptions.SCLSyntaxErrorException; import org.simantics.scl.compiler.internal.parsing.types.TypeAst; import org.simantics.scl.compiler.types.TCon; +import org.simantics.scl.compiler.types.TMetaVar; import org.simantics.scl.compiler.types.TPred; import org.simantics.scl.compiler.types.TVar; import org.simantics.scl.compiler.types.Type; @@ -25,6 +26,7 @@ public class TypeTranslationContext { ErrorLog errorLog; THashMap typeVariables = new THashMap(); + THashMap existentials; public TypeTranslationContext(CompilationContext compilationContext) { this.compilationContext = compilationContext; @@ -80,6 +82,19 @@ public class TypeTranslationContext { return var; } + public TMetaVar resolveExistential(long loc, String name, Kind expectedKind) { + if(existentials == null) + existentials = new THashMap(); + TMetaVar var = existentials.get(name); + if(var == null) { + var = Types.metaVar(expectedKind); + existentials.put(name, var); + } + else + unify(loc, var.getKind(), expectedKind); + return var; + } + public TVar pushTypeVar(String name) { return typeVariables.put(name, Types.var(Kinds.metaVar())); } diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/parsing/types/TVarAst.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/parsing/types/TVarAst.java index e95b3ad9a..84d3e3a01 100644 --- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/parsing/types/TVarAst.java +++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/parsing/types/TVarAst.java @@ -56,6 +56,8 @@ public class TVarAst extends TypeAst { } else if(Character.isLowerCase(c)) return context.resolveTypeVariable(location, name, expectedKind); + else if(c == '?') + return context.resolveExistential(location, name, expectedKind); else { TypeDescriptor tdesc; try { @@ -105,6 +107,8 @@ public class TVarAst extends TypeAst { } else if(Character.isLowerCase(c)) return context.resolveTypeVariable(name); + else if(c == '?') + return context.resolveExistential(name); else { con = context.resolveTypeConstructor(name); if(con == null) { @@ -150,6 +154,8 @@ public class TVarAst extends TypeAst { char c = name.charAt(0); if(Character.isLowerCase(c)) return context.resolveTypeVariable(name); + else if(c == '?') + return context.resolveExistential(name); else { Type con = context.resolveTypeConstructor(name); if(con == null) { diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/types/TypeElaborationContext.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/types/TypeElaborationContext.java index bfde46773..8e638a089 100644 --- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/types/TypeElaborationContext.java +++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/types/TypeElaborationContext.java @@ -1,5 +1,6 @@ package org.simantics.scl.compiler.internal.types; +import org.simantics.scl.compiler.types.TMetaVar; import org.simantics.scl.compiler.types.TVar; import org.simantics.scl.compiler.types.Type; import org.simantics.scl.compiler.types.Types; @@ -10,7 +11,8 @@ import gnu.trove.map.hash.THashMap; public class TypeElaborationContext { - THashMap vars; + THashMap vars; + THashMap existentials; ITypeEnvironment environment; public TypeElaborationContext( @@ -24,17 +26,28 @@ public class TypeElaborationContext { this(new THashMap(), environment); } + public TMetaVar resolveExistential(String varName) { + if(existentials == null) + existentials = new THashMap(); + TMetaVar var = existentials.get(varName); + if(var == null) { + var = Types.metaVar(Kinds.metaVar()); + existentials.put(varName, var); + } + return var; + } + public TVar resolveTypeVariable(String varName) { TVar var = vars.get(varName); if(var == null) { - var = Types.var(Kinds.STAR /* FIXME */); + var = Types.var(Kinds.metaVar()); vars.put(varName, var); } return var; } - + public TVar push(String varName) { - return vars.put(varName, Types.var(Kinds.STAR /* FIXME */)); + return vars.put(varName, Types.var(Kinds.metaVar())); } public TVar pop(String varName, TVar oldVar) { diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/types/ast/TVarAst.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/types/ast/TVarAst.java index 24a6d9aeb..b9c8b6b57 100644 --- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/types/ast/TVarAst.java +++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/types/ast/TVarAst.java @@ -19,7 +19,7 @@ public class TVarAst extends TypeAst { @Override public Type toType(TypeElaborationContext context) { - return context.resolveTypeVariable(name); + return name.startsWith("?") ? context.resolveExistential(name) : context.resolveTypeVariable(name); } @Override diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/types/Types.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/types/Types.java index 50eec32fe..00e60a636 100644 --- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/types/Types.java +++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/types/Types.java @@ -1124,17 +1124,9 @@ public class Types { return parseType(new TypeElaborationContext(environment), text); } - public static Type parseType(ITypeEnvironment environment, THashMap localTypeVars, String text) throws SCLTypeParseException { - return parseType(new TypeElaborationContext(localTypeVars, environment), text); - } - public static Type parseType(String text) throws SCLTypeParseException { return parseType(new TypeElaborationContext(DUMMY_TYPE_ENVIRONMENT), text); } - - public static Type parseType(THashMap localTypeVars, String text) throws SCLTypeParseException { - return parseType(new TypeElaborationContext(localTypeVars, DUMMY_TYPE_ENVIRONMENT), text); - } private static Type parseType(TypeElaborationContext context, String text) throws SCLTypeParseException { SCLParserImpl parser = new SCLParserImpl(new StringReader(text)); diff --git a/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/InitialRepository.java b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/InitialRepository.java index 5608689f5..87ea5274d 100644 --- a/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/InitialRepository.java +++ b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/InitialRepository.java @@ -1,5 +1,8 @@ package org.simantics.scl.compiler.tests; +import org.simantics.scl.compiler.environment.Environment; +import org.simantics.scl.compiler.environment.specification.EnvironmentSpecification; +import org.simantics.scl.compiler.module.repository.ImportFailureException; import org.simantics.scl.compiler.module.repository.ModuleRepository; import org.simantics.scl.compiler.source.repository.CompositeModuleSourceRepository; import org.simantics.scl.compiler.source.repository.SourceRepositories; @@ -14,6 +17,12 @@ public class InitialRepository { SourceRepositories.PRELUDE_SOURCE_REPOSITORY )); + public static EnvironmentSpecification DEFAULT_ENVIRONMENT_SPECIFICATION = new EnvironmentSpecification(); + static { + DEFAULT_ENVIRONMENT_SPECIFICATION.importModule("Builtin", ""); + DEFAULT_ENVIRONMENT_SPECIFICATION.importModule("Prelude", ""); + } + public static ModuleRepository getInitialRepository() { if(NO_PRELUDE) return new ModuleRepository(SourceRepositories.BUILTIN_SOURCE_REPOSITORY); @@ -22,4 +31,8 @@ public class InitialRepository { else return SCLOsgi.MODULE_REPOSITORY; } + + public static Environment getDefaultEnvironment() throws ImportFailureException { + return getInitialRepository().createEnvironment(DEFAULT_ENVIRONMENT_SPECIFICATION, null); + } } diff --git a/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/experimentation/TestExistential.java b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/experimentation/TestExistential.java new file mode 100644 index 000000000..31f998186 --- /dev/null +++ b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/experimentation/TestExistential.java @@ -0,0 +1,24 @@ +package org.simantics.scl.compiler.tests.experimentation; + +import org.junit.Assert; +import org.junit.Test; +import org.simantics.scl.compiler.environment.Environment; +import org.simantics.scl.compiler.environment.Environments; +import org.simantics.scl.compiler.module.repository.ImportFailureException; +import org.simantics.scl.compiler.tests.InitialRepository; +import org.simantics.scl.compiler.types.Type; +import org.simantics.scl.compiler.types.Types; +import org.simantics.scl.compiler.types.exceptions.UnificationException; + +public class TestExistential { + @Test + public void testExistentialTypes() throws ImportFailureException, UnificationException { + Environment environment = InitialRepository.getDefaultEnvironment(); + Type type1 = Environments.getType(environment, "?a -> String -> ?a"); + Type type2 = Environments.getType(environment, "Integer -> ?b -> ?c"); + Assert.assertEquals("a -> String -> a", type1.toString()); + Assert.assertEquals("Integer -> a -> b", type2.toString()); + Types.unify(type1, type2); + Assert.assertEquals("Integer -> String -> Integer", type1.toString()); + } +} -- 2.43.2