(refs #7414) Added Dynamic constructor

Change-Id: I64bd802966ac2f44b88b1b6d87518a730a0a6203

diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/constants/LocalVariableConstant.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/constants/LocalVariableConstant.java
index 7de438d151e57844f05c9c065435870ed6f129c7..336ed04e3d47afe546bdaf0c649e2bc59ac26f5b 100644 (file)
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/constants/LocalVariableConstant.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/constants/LocalVariableConstant.java
@@ -8,7 +8,7 @@ import org.simantics.scl.compiler.types.Type;
 
 public class LocalVariableConstant extends Constant {
 
-    LocalVariable var;
+    public LocalVariable var;
     
     public LocalVariableConstant(Type type, LocalVariable var) {
         super(type);

diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/EConstant.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/EConstant.java
index a668fe12b1cb036f17c69d477283bf01a0dc488f..b33ebcf2551ca99ad34612bd2a978d53ce975025 100644 (file)
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/EConstant.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/EConstant.java
@@ -15,6 +15,7 @@ import org.simantics.scl.compiler.elaboration.contexts.TypingContext;
 import org.simantics.scl.compiler.elaboration.errors.NotPatternException;
 import org.simantics.scl.compiler.elaboration.expressions.lhstype.LhsType;
 import org.simantics.scl.compiler.elaboration.expressions.lhstype.PatternMatchingLhs;
+import org.simantics.scl.compiler.elaboration.java.DynamicConstructor;
 import org.simantics.scl.compiler.elaboration.modules.SCLValue;
 import org.simantics.scl.compiler.errors.Locations;
 import org.simantics.scl.compiler.internal.codegen.references.IVal;
@@ -190,7 +191,7 @@ public class EConstant extends Expression {
             context.recursiveReferences.add(placeholder);
             return placeholder;
         }
-        else if(context.isInPattern()) {
+        else if(context.isInPattern() && value.getValue() != DynamicConstructor.INSTANCE /* HACK!! */) {
             /* This is little hackish code that handles the following kind of constructors:
              *   data Thunk a = Thunk s (a -> s)
              * in

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 4d48d1e9cb1442ec5854728b2b83518e985b859b..6df643ea38e17f1e51f2689d0288b7f379d02718 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
@@ -177,6 +177,10 @@ public class Builtins extends ConcreteModule {
                 new Constructor(Locations.NO_LOCATION, MaybeType.INSTANCE, Just.getName(), new Type[] {MaybeType.INSTANCE.parameters[0]}, null)
                 );
 
+        // *** Dynamic ***
+        
+        addValue("Dynamic", DynamicConstructor.INSTANCE);
+        
         // *** Vector ***
         
         TypeClass VecCompC = new TypeClass(Locations.NO_LOCATION, 

diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/java/DynamicConstructor.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/java/DynamicConstructor.java
new file mode 100644 (file)
index 0000000..078e7f6
--- /dev/null
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/java/DynamicConstructor.java
@@ -0,0 +1,51 @@
+package org.simantics.scl.compiler.elaboration.java;
+
+import org.cojen.classfile.TypeDesc;
+import org.objectweb.asm.Label;
+import org.simantics.scl.compiler.constants.FunctionValue;
+import org.simantics.scl.compiler.constants.LocalVariableConstant;
+import org.simantics.scl.compiler.internal.codegen.continuations.Cont;
+import org.simantics.scl.compiler.internal.codegen.references.IVal;
+import org.simantics.scl.compiler.internal.codegen.references.Val;
+import org.simantics.scl.compiler.internal.codegen.utils.LocalVariable;
+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;
+
+/**
+ * Dynamic :: a -> Dynamic
+ */
+public class DynamicConstructor extends FunctionValue {
+    private static final TVar A = Types.var(Kinds.STAR);
+    public static final DynamicConstructor INSTANCE = new DynamicConstructor();
+    
+    private DynamicConstructor() {
+        super(new TVar[] {A}, Types.NO_EFFECTS, Types.DYNAMIC, A);
+    }
+
+    @Override
+    public Type applyExact(MethodBuilder mb, Val[] parameters) {
+        mb.pushBoxed(parameters[0]);
+        return Types.DYNAMIC;
+    }
+
+    @Override
+    public void deconstruct(MethodBuilder mb, IVal parameter, Cont success, Label failure) {
+        Type expectedType = success.getParameterType(0);
+        TypeDesc expectedTypeDesc = mb.getJavaTypeTranslator().toTypeDesc(expectedType);
+        TypeDesc expectedObjectTypeDesc = expectedTypeDesc.toObjectType();
+        LocalVariable cachedParameter = mb.cacheValue(parameter, Types.DYNAMIC);
+        mb.loadLocal(cachedParameter);
+        mb.instanceOf(expectedObjectTypeDesc);
+        mb.ifZeroComparisonBranch(failure, "==");
+        
+        mb.loadLocal(cachedParameter);
+        mb.checkCast(expectedObjectTypeDesc);
+        mb.unbox(expectedType);
+        LocalVariable casted = mb.createLocalVariable("dynamicContent", expectedTypeDesc); 
+        mb.storeLocal(casted);
+        mb.jump(success, new LocalVariableConstant(expectedType, casted));
+    }
+}

diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/codegen/utils/MethodBuilder.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/codegen/utils/MethodBuilder.java
index 56b5c8e6767141bfae285180962016409a7ed975..52d19cc5474526386485205bc1cce5be35015af9 100644 (file)
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/codegen/utils/MethodBuilder.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/codegen/utils/MethodBuilder.java
@@ -4,6 +4,7 @@ import org.cojen.classfile.TypeDesc;
 import org.objectweb.asm.Label;
 import org.objectweb.asm.MethodVisitor;
 import org.simantics.scl.compiler.common.exceptions.InternalCompilerError;
+import org.simantics.scl.compiler.constants.LocalVariableConstant;
 import org.simantics.scl.compiler.internal.codegen.continuations.Cont;
 import org.simantics.scl.compiler.internal.codegen.continuations.ContRef;
 import org.simantics.scl.compiler.internal.codegen.continuations.ReturnCont;
@@ -231,6 +232,9 @@ public class MethodBuilder extends MethodBuilderBase {
             if(!boundVar.generateOnFly)
                 return getLocalVariable(boundVar);
         }
+        else if(val instanceof LocalVariableConstant) {
+            return ((LocalVariableConstant)val).var;
+        }
         push(val, type);
         LocalVariable temp = createLocalVariable(null, getJavaTypeTranslator().toTypeDesc(type));
         storeLocal(temp);

diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/elaboration/matching/PatternMatchingCompiler.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/elaboration/matching/PatternMatchingCompiler.java
index 12bf42e5bed980910034d3aa661938341a743247..62b2ec1aaf4bc9894d14d8dabb957c80b234853f 100644 (file)
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/elaboration/matching/PatternMatchingCompiler.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/elaboration/matching/PatternMatchingCompiler.java
@@ -17,6 +17,7 @@ import org.simantics.scl.compiler.elaboration.expressions.EVariable;
 import org.simantics.scl.compiler.elaboration.expressions.EViewPattern;
 import org.simantics.scl.compiler.elaboration.expressions.Expression;
 import org.simantics.scl.compiler.elaboration.expressions.GuardedExpressionGroup;
+import org.simantics.scl.compiler.elaboration.java.DynamicConstructor;
 import org.simantics.scl.compiler.elaboration.modules.SCLValue;
 import org.simantics.scl.compiler.elaboration.modules.TypeConstructor;
 import org.simantics.scl.compiler.internal.codegen.continuations.Branch;
@@ -94,7 +95,7 @@ public class PatternMatchingCompiler {
                 if(constructor_ instanceof EConstant) {
                     SCLValue constructor = ((EConstant)constructor_).getValue();
     
-                    ExpressionMatrix matrix = matrixMap.get(constructor.getName());
+                    ExpressionMatrix matrix = constructor.getValue() == DynamicConstructor.INSTANCE ? null : matrixMap.get(constructor.getName());
                     if(matrix == null) {
                         CodeWriter newW = w.createBlock(Types.getTypes(parameters));
                         branches.add(new Branch((Constant)constructor.getValue(), newW.getContinuation()));

diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/elaboration/matching2/PatternMatchingCompiler2.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/elaboration/matching2/PatternMatchingCompiler2.java
index 8ca51b275f900a439d5b7a5025ab3d2e96444588..24a3bfb2edcc2e8208aefa4435974fec8b31af47 100644 (file)
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/elaboration/matching2/PatternMatchingCompiler2.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/elaboration/matching2/PatternMatchingCompiler2.java
@@ -16,6 +16,7 @@ import org.simantics.scl.compiler.elaboration.expressions.ELiteral;
 import org.simantics.scl.compiler.elaboration.expressions.EVariable;
 import org.simantics.scl.compiler.elaboration.expressions.EViewPattern;
 import org.simantics.scl.compiler.elaboration.expressions.Expression;
+import org.simantics.scl.compiler.elaboration.java.DynamicConstructor;
 import org.simantics.scl.compiler.elaboration.modules.SCLValue;
 import org.simantics.scl.compiler.elaboration.modules.TypeConstructor;
 import org.simantics.scl.compiler.internal.codegen.continuations.Branch;
@@ -93,7 +94,7 @@ public class PatternMatchingCompiler2 {
                 if(constructor_ instanceof EConstant) {
                     SCLValue constructor = ((EConstant)constructor_).getValue();
     
-                    ExpressionMatrix matrix = matrixMap.get(constructor.getName());
+                    ExpressionMatrix matrix = constructor.getValue() == DynamicConstructor.INSTANCE ? null : matrixMap.get(constructor.getName());
                     if(matrix == null) {
                         CodeWriter newW = w.createBlock(Types.getTypes(parameters));
                         branches.add(new Branch((Constant)constructor.getValue(), newW.getContinuation()));

diff --git a/bundles/org.simantics.scl.runtime/scl/Prelude.scl b/bundles/org.simantics.scl.runtime/scl/Prelude.scl
index c81f8308954e8ee241653b686b8d0bcbeffdaa6c..eb1e8cd6ff35bed0186d22d68e7b115626246d04 100644 (file)
--- a/bundles/org.simantics.scl.runtime/scl/Prelude.scl
+++ b/bundles/org.simantics.scl.runtime/scl/Prelude.scl
@@ -1540,6 +1540,24 @@ joinWithSeparator :: Show a => String -> [a] -> String
 joinWithSeparator separator values = runProc ( 
     StringBuilder.toString $ printWithSeparator StringBuilder.new separator values)
 
+
+intercalate :: String -> [String] -> String
+intercalate separator strings = do
+    l = length strings
+    if l == 0
+    then ""
+    else if l == 1
+    then strings!0
+    else runProc do
+        sb = StringBuilder.new
+        sb << strings!0
+        loop i | i == l = ()
+               | otherwise = do
+            sb << separator << strings!i
+            loop (i+1)
+        loop 1
+        StringBuilder.toString sb
+
 instance (Show a) => Show [a] where
     sb <+ l = do 
         len = length l

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 39b53b8b548476e673a657728e250d318c45ec73..cf3aa021b44981dddb463588e46b0bc5cfeb0b46 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
@@ -51,7 +51,8 @@ public class ModuleRegressionTests extends TestBase {
     @Test public void DifferentBranchTypes() { test(); }
     @Test public void Div() { test(); }
     @Test public void DoubleConversion() { test(); }
-    @Test public void DoubleEffect() { test(); }    
+    @Test public void DoubleEffect() { test(); }
+    @Test public void Dynamic1() { test(); }
     @Test public void Effects1() { test(); }
     @Test public void Effects2() { test(); }  
     @Test public void Effects3() { test(); }

diff --git a/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/Dynamic1.scl b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/Dynamic1.scl
new file mode 100644 (file)
index 0000000..ca32ea4
--- /dev/null
+++ b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/Dynamic1.scl
@@ -0,0 +1,13 @@
+import "Prelude"
+
+myShow :: Dynamic -> String
+myShow (Dynamic v) = show (v :: Integer)
+myShow (Dynamic v) = show (v :: Double)
+myShow (Dynamic v) = show (v :: String)
+myShow (Dynamic v) = show (v :: Boolean)
+myShow (Dynamic v) = "[\(intercalate ", " $ map myShow v)]"
+myShow _ = "Unknown"
+
+main = myShow $ Dynamic [Dynamic False, Dynamic (3 :: Integer), Dynamic (3.1 :: Double), Dynamic "Foo"]
+--
+[False, 3, 3.1, "Foo"]
\ No newline at end of file