(refs #7767) SafeDynamic module

Change-Id: I7691aa77ab048f71b7906512bd6962bd52b2e230

diff --git a/bundles/org.simantics.scl.compiler/META-INF/MANIFEST.MF b/bundles/org.simantics.scl.compiler/META-INF/MANIFEST.MF
index c36c46274f65fffe96cc713c16f82c595b0455ad..91014207da4e9452fd154d1d64253dd327983e0e 100644 (file)
--- a/bundles/org.simantics.scl.compiler/META-INF/MANIFEST.MF
+++ b/bundles/org.simantics.scl.compiler/META-INF/MANIFEST.MF
@@ -22,6 +22,7 @@ Export-Package: org.cojen.classfile,
  org.simantics.scl.compiler.completions.parsing,
  org.simantics.scl.compiler.constants,
  org.simantics.scl.compiler.constants.generic,
+ org.simantics.scl.compiler.dynamic,
  org.simantics.scl.compiler.elaboration.chr,
  org.simantics.scl.compiler.elaboration.chr.plan,
  org.simantics.scl.compiler.elaboration.chr.planning,

diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/constants/JavaTypeClassSuper.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/constants/JavaTypeClassSuper.java
index ae536b154dd658b6ec8435c8b894528adc1bcb8f..5b2961e2eb35cf680729b1d3e7bf8d13fc0bd684 100644 (file)
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/constants/JavaTypeClassSuper.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/constants/JavaTypeClassSuper.java
@@ -28,6 +28,7 @@ public class JavaTypeClassSuper extends JavaMethod {
             IVal newVal = instance.superExpressions[superId].getValue();
             apply.getTarget().replaceBy(newVal.createOccurrence());
             apply.remove();
+            context.markModified("inline-super");
         }
     }
     

diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/constants/singletons/ThrowFunction.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/constants/singletons/ThrowFunction.java
index f98e635c2bbb7c86863dba8c2432bd8bcedea617..5a6f4068c00f926971fe8f59cd50c4d943e3d216 100644 (file)
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/constants/singletons/ThrowFunction.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/constants/singletons/ThrowFunction.java
@@ -48,5 +48,6 @@ public class ThrowFunction extends FunctionValue {
         apply.detachThisAndSuccessors();
         block.getExit().destroy();
         block.setExit(new Throw2(apply.getParameters()[0]));
+        context.markModified("inline-throw");
     }
 }

diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/constants/singletons/TypeOfConstant.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/constants/singletons/TypeOfConstant.java
index b0a0639b274f0ee3a1116d116f25efc182c4b466..f99f2ac78ad93cf5fc2d9fd09342c4eaa0a44da4 100644 (file)
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/constants/singletons/TypeOfConstant.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/constants/singletons/TypeOfConstant.java
@@ -1,9 +1,13 @@
 package org.simantics.scl.compiler.constants.singletons;
 
+import java.util.Arrays;
+
 import org.simantics.scl.compiler.constants.FunctionValue;
 import org.simantics.scl.compiler.internal.codegen.references.Val;
+import org.simantics.scl.compiler.internal.codegen.references.ValRef;
+import org.simantics.scl.compiler.internal.codegen.ssa.statements.LetApply;
 import org.simantics.scl.compiler.internal.codegen.utils.MethodBuilder;
-import org.simantics.scl.compiler.types.TCon;
+import org.simantics.scl.compiler.internal.codegen.utils.SSASimplificationContext;
 import org.simantics.scl.compiler.types.TVar;
 import org.simantics.scl.compiler.types.Type;
 import org.simantics.scl.compiler.types.Types;
@@ -11,17 +15,16 @@ import org.simantics.scl.compiler.types.kinds.Kinds;
 
 public class TypeOfConstant extends FunctionValue {
     private static final TVar A = Types.var(Kinds.STAR);
-    private static final TCon Type = Types.con(Types.BUILTIN, "Type");
     public static final TypeOfConstant INSTANCE = new TypeOfConstant();
     
     private TypeOfConstant() {
-        super(new TVar[] {A}, Types.NO_EFFECTS, Type, 
+        super(new TVar[] {A}, Types.NO_EFFECTS, Types.TYPE, 
                 Types.pred(Types.TYPEABLE, A), A);
     }
     
     @Override
     public Type applyExact(MethodBuilder mb, Val[] parameters) {
-        mb.push(parameters[0], Type);
+        mb.push(parameters[0], Types.TYPE);
         return getReturnType();
     }
     
@@ -29,4 +32,17 @@ public class TypeOfConstant extends FunctionValue {
     public String toString() {
         return "typeOf";
     }
+    
+    @Override
+    public void inline(SSASimplificationContext context, LetApply apply) {
+        ValRef[] parameters = apply.getParameters();
+        if(parameters.length == 2) {
+            parameters[1].remove();
+            apply.setParameters(Arrays.copyOf(parameters, 1));
+        }
+        ValRef oldFunc = apply.getFunction();
+        apply.setFunction(TypeValueConstant.INSTANCE.createOccurrence(oldFunc.getTypeParameters()));
+        oldFunc.remove();
+        context.markModified("inline-typeOf");
+    }
 }
\ No newline at end of file

diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/constants/singletons/TypeValueConstant.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/constants/singletons/TypeValueConstant.java
new file mode 100644 (file)
index 0000000..4966a8c
--- /dev/null
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/constants/singletons/TypeValueConstant.java
@@ -0,0 +1,30 @@
+package org.simantics.scl.compiler.constants.singletons;
+
+import org.simantics.scl.compiler.constants.FunctionValue;
+import org.simantics.scl.compiler.internal.codegen.references.Val;
+import org.simantics.scl.compiler.internal.codegen.utils.MethodBuilder;
+import org.simantics.scl.compiler.types.TVar;
+import org.simantics.scl.compiler.types.Type;
+import org.simantics.scl.compiler.types.Types;
+import org.simantics.scl.compiler.types.kinds.Kinds;
+
+public class TypeValueConstant extends FunctionValue {
+    private static final TVar A = Types.var(Kinds.STAR);
+    public static final TypeValueConstant INSTANCE = new TypeValueConstant();
+    
+    private TypeValueConstant() {
+        super(new TVar[] {A}, Types.NO_EFFECTS, Types.TYPE,
+                Types.pred(Types.TYPEABLE, A));
+    }
+    
+    @Override
+    public Type applyExact(MethodBuilder mb, Val[] parameters) {
+        mb.push(parameters[0], Types.TYPE);
+        return getReturnType();
+    }
+    
+    @Override
+    public String toString() {
+        return "typeValue";
+    }
+}
\ No newline at end of file

diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/dynamic/SafeDynamic.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/dynamic/SafeDynamic.java
new file mode 100644 (file)
index 0000000..45c0710
--- /dev/null
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/dynamic/SafeDynamic.java
@@ -0,0 +1,30 @@
+package org.simantics.scl.compiler.dynamic;
+
+import org.simantics.scl.compiler.types.Type;
+
+public class SafeDynamic {
+    public final Type type_;
+    public final Object value;
+    
+    public SafeDynamic(Type type_, Object value) {
+        this.type_ = type_;
+        this.value = value;
+    }
+
+    public String toString() {
+        return new StringBuilder().append("(SafeDynamic").append(" ").append((Object)this.type_).append(" ").append(this.value).append(")").toString();
+    }
+    
+    public boolean equals(Object other) {
+        if(this == other)
+            return true;
+        if(other == null || !other.getClass().equals(SafeDynamic.class))
+            return false;
+        SafeDynamic dyn = (SafeDynamic)other;
+        return type_.equals(dyn.type_) && (value == null ? dyn.value == null : value.equals(dyn.value));
+    }
+    
+    public int hashCode() {
+        return 31*type_.hashCode()+(value==null ? -957171758 : value.hashCode());
+    }
+}

diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/java/Builtins.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/java/Builtins.java
index ec82b3e4a1aaff2c319c3c82be66b3e37c5d392d..083c3d58f132afb00f11cb79a5b1dd1ea22ee3e3 100644 (file)
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/java/Builtins.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/java/Builtins.java
@@ -23,6 +23,7 @@ import org.simantics.scl.compiler.constants.singletons.ThrowFunction;
 import org.simantics.scl.compiler.constants.singletons.TypeOfConstant;
 import org.simantics.scl.compiler.constants.singletons.TypeOfProxyConstant;
 import org.simantics.scl.compiler.constants.singletons.TypeProxyConstant;
+import org.simantics.scl.compiler.constants.singletons.TypeValueConstant;
 import org.simantics.scl.compiler.elaboration.fundeps.Fundep;
 import org.simantics.scl.compiler.elaboration.modules.Documentation;
 import org.simantics.scl.compiler.elaboration.modules.PrivateProperty;
@@ -303,6 +304,7 @@ public class Builtins extends ConcreteModule {
             // typeOf :: Typeable a => a -> Type
             addValue("typeOf", TypeOfConstant.INSTANCE)
             .documentation = "Returns the type of the value given as a parameter.";
+            addValue("typeValue", TypeValueConstant.INSTANCE);
             addValue("typeOfProxy", TypeOfProxyConstant.INSTANCE)
             .documentation = "Returns the type of the type proxy given as a parameter.";
             addValue("TypeProxy", TypeProxyConstant.INSTANCE);

diff --git a/bundles/org.simantics.scl.runtime/scl/SafeDynamic.scl b/bundles/org.simantics.scl.runtime/scl/SafeDynamic.scl
new file mode 100644 (file)
index 0000000..b113f8a
--- /dev/null
+++ b/bundles/org.simantics.scl.runtime/scl/SafeDynamic.scl
@@ -0,0 +1,22 @@
+import "Prelude"
+import "JavaBuiltin" as Java
+
+@JavaType "org.simantics.scl.compiler.dynamic.SafeDynamic"
+data SafeDynamic =
+    @FieldNames [type_, value]
+    SafeDynamic Type Dynamic
+
+toSafeDynamic :: Typeable a => a -> SafeDynamic
+toSafeDynamic val = SafeDynamic (typeOf val) (toDynamic val)
+
+fromSafeDynamic :: Typeable a => SafeDynamic -> Maybe a
+fromSafeDynamic (SafeDynamic type_ value) =
+    if type_ == typeOfProxy (TypeProxy :: TypeProxy a)
+    then Just (Java.unsafeCoerce value)
+    else Nothing
+
+forgetType :: SafeDynamic -> Dynamic
+forgetType (SafeDynamic _ value) = value
+
+typeOfSafeDynamic :: SafeDynamic -> Type
+typeOfSafeDynamic (SafeDynamic t _) = t

diff --git a/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/ModuleRegressionTests.java b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/ModuleRegressionTests.java
index 6c17830273c43eed42ab7688cd93e2512437050b..2224cc0546be96e174b42f619c8a4e06da183669 100644 (file)
--- a/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/ModuleRegressionTests.java
+++ b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/ModuleRegressionTests.java
@@ -231,6 +231,7 @@ public class ModuleRegressionTests extends TestBase {
     @Test public void RepeatedVariableDefinitionBug() { test(); }
     @Test public void RepeatedVariableInPattern() { test(); }
     @Test public void Scanl() { test(); }
+    @Test public void SafeDynamic1() { test(); }
     @Test public void Search() { test(); }
     @Test public void Sections() { test(); }
     @Test public void Select1() { test(); }

diff --git a/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/SafeDynamic1.scl b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/SafeDynamic1.scl
new file mode 100644 (file)
index 0000000..f18fd7b
--- /dev/null
+++ b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/SafeDynamic1.scl
@@ -0,0 +1,17 @@
+import "Prelude"
+import "SafeDynamic"
+
+a = toSafeDynamic (1 :: Double)
+b = toSafeDynamic (2 :: Integer)
+
+main = do
+    print (fromSafeDynamic a :: Maybe Double)
+    print (fromSafeDynamic a :: Maybe Integer)
+    print (fromSafeDynamic b :: Maybe Double)
+    print (fromSafeDynamic b :: Maybe Integer)
+----
+Just 1.0
+Nothing
+Nothing
+Just 2
+()
\ No newline at end of file