From: Hannu Niemistö <hannu.niemisto@semantum.fi>
Date: Wed, 1 Nov 2017 07:11:18 +0000 (+0200)
Subject: (refs #7588) Support for existential type variables with syntax ?v
X-Git-Tag: v1.31.0~72
X-Git-Url: https://gerrit.simantics.org/r/gitweb?a=commitdiff_plain;h=4c2fb8fefbdec1856e160dc24b6498aa4bd5eb48;p=simantics%2Fplatform.git

(refs #7588) Support for existential type variables with syntax ?v

Change-Id: I418a9d260c02c7082e7a7359b90659ea2c3a96d4
---

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<String, TVar> typeVariables = new THashMap<String, TVar>();
+    THashMap<String, TMetaVar> 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<String, TMetaVar>();
+        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<String, TVar> vars; 
+    THashMap<String, TVar> vars;
+    THashMap<String, TMetaVar> existentials;
     ITypeEnvironment environment;
         
     public TypeElaborationContext(
@@ -24,17 +26,28 @@ public class TypeElaborationContext {
         this(new THashMap<String, TVar>(), environment);
     }
 
+    public TMetaVar resolveExistential(String varName) {
+        if(existentials == null)
+            existentials = new THashMap<String, TMetaVar>();
+        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<String, TVar> 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<String, TVar> 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());
+    }
+}