#430121
"""
-addSubscription :: Variable -> <WriteGraph,ReadGraph> Subscription
+addSubscription :: Variable -> <WriteGraph> Subscription
addSubscription variable = do
model = modelOfVariable variable
default = defaultSubscriptionFolder model
import org.simantics.scl.compiler.elaboration.contexts.TranslationContext;
import org.simantics.scl.compiler.elaboration.contexts.TypingContext;
import org.simantics.scl.compiler.elaboration.expressions.Expression;
+import org.simantics.scl.compiler.elaboration.expressions.ExpressionVisitor;
import org.simantics.scl.compiler.elaboration.expressions.Variable;
import org.simantics.scl.compiler.elaboration.expressions.printing.ExpressionToStringVisitor;
+import org.simantics.scl.compiler.elaboration.expressions.visitors.ForVariablesUsesVisitor;
+import org.simantics.scl.compiler.elaboration.expressions.visitors.StandardExpressionVisitor;
import org.simantics.scl.compiler.errors.Locations;
import org.simantics.scl.compiler.internal.parsing.Symbol;
newLiterals[i] = literals[i].replace(context);
return new CHRQuery(location, newLiterals);
}
+
+ public void accept(ExpressionVisitor visitor) {
+ for(CHRLiteral literal : literals) {
+ if(literal == null || literal.parameters == null)
+ continue; // FIXME why this happens?
+ for(Expression parameter : literal.parameters) {
+ if(parameter == null)
+ continue; // FIXME why this happens?
+ parameter.accept(visitor);
+ }
+ }
+ }
}
package org.simantics.scl.compiler.elaboration.chr;
import java.util.ArrayList;
+import java.util.HashMap;
import org.simantics.scl.compiler.compilation.CompilationContext;
import org.simantics.scl.compiler.elaboration.chr.plan.CHRSearchPlan;
import org.simantics.scl.compiler.elaboration.contexts.SimplificationContext;
import org.simantics.scl.compiler.elaboration.contexts.TranslationContext;
import org.simantics.scl.compiler.elaboration.contexts.TypingContext;
+import org.simantics.scl.compiler.elaboration.expressions.EAsPattern;
import org.simantics.scl.compiler.elaboration.expressions.EVariable;
+import org.simantics.scl.compiler.elaboration.expressions.Expression;
+import org.simantics.scl.compiler.elaboration.expressions.ExpressionVisitor;
import org.simantics.scl.compiler.elaboration.expressions.Variable;
import org.simantics.scl.compiler.elaboration.expressions.printing.ExpressionToStringVisitor;
+import org.simantics.scl.compiler.elaboration.expressions.visitors.StandardExpressionVisitor;
import org.simantics.scl.compiler.errors.Locations;
import org.simantics.scl.compiler.internal.parsing.Symbol;
import org.simantics.scl.compiler.types.Types;
context.disallowNewExistentials();
body.resolve(context);
existentialVariables = context.popExistentialFrame();
+
+ warnForExistentialsUsedOnlyOnce(context);
+ }
+
+ private static final Object NEVER_USED = new Object();
+
+ private void warnForExistentialsUsedOnlyOnce(TranslationContext context) {
+ // Initialize the hash map
+ HashMap<Variable, Object> usageCount = new HashMap<>(existentialVariables.length);
+ for(Variable var : existentialVariables)
+ if(!var.getName().equals("_"))
+ usageCount.put(var, NEVER_USED);
+
+ // Collect variable uses
+ ExpressionVisitor visitor = new StandardExpressionVisitor() {
+ private void handle(Expression expression, Variable variable) {
+ Object object = usageCount.remove(variable);
+ if(object == NEVER_USED)
+ usageCount.put(variable, expression);
+ }
+ @Override
+ public void visit(EVariable expression) {
+ if(expression.variable != null)
+ handle(expression, expression.variable);
+ }
+ @Override
+ public void visit(EAsPattern expression) {
+ expression.pattern.accept(this);
+ handle(expression, expression.var);
+ }
+ };
+ head.accept(visitor);
+ body.accept(visitor);
+
+ // Report as warnings
+ usageCount.forEach((variable, expression_) -> {
+ if(!(expression_ instanceof Expression))
+ return; // Should never happen
+ Expression expression = (Expression)expression_;
+ if(context.isExpandedFromWildcard(expression))
+ return;
+
+ context.getErrorLog().logWarning(expression.location,
+ "Existential variable " + variable.getName() + " is referred only once. Replace by _ if this is a wildcard.");
+ });
+
}
public void checkType(TypingContext context) {
TIntArrayList chrConstraintFrames = new TIntArrayList();
ArrayList<CHRConstraintEntry> chrConstraintEntries = new ArrayList<CHRConstraintEntry>();
+ private THashSet<Expression> expandedFromWildcard;
+
public CHRRuleset currentRuleset;
public ModuleDebugInfo moduleDebugInfo;
variable = new Variable(name);
variables.put(name, variable);
existentialFrame.variables.add(name);
- return new EVariable(variable);
+ return new EVariable(location, variable);
}
case '_': {
if(name.length()==1) {
return Environments.getRuleset(environment, name);
}
+ /**
+ * Tells that new existential variables are no longer allowed in this context.
+ */
public void disallowNewExistentials() {
getCurrentExistentialFrame().disallowNewExistentials = true;
}
+
+ /**
+ * Marks that the expression is a result of expanding .. wildcard pattern in records.
+ */
+ public void addExpandedFromWildcard(Expression expression) {
+ if(expandedFromWildcard == null)
+ expandedFromWildcard = new THashSet<>();
+ expandedFromWildcard.add(expression);
+ }
+
+ /**
+ * Asks if the expression is a result of expanding .. wildcard pattern in records.
+ */
+ public boolean isExpandedFromWildcard(Expression expression) {
+ if(expandedFromWildcard == null)
+ return false;
+ else
+ return expandedFromWildcard.contains(expression);
+ }
}
String variableName = fieldNames[i];
if(chrLiteral)
variableName = "?" + variableName;
- parameters[i] = new EVar(wildcardField.location, variableName);
+ EVar expandedVar = new EVar(wildcardField.location, variableName);
+ parameters[i] = expandedVar;
+ context.addExpandedFromWildcard(expandedVar);
}
}
if(!recordMap.isEmpty()) {
@Override
public Expression resolve(TranslationContext context) {
- return context.resolveVariable(location, name);
+ Expression resolved = context.resolveVariable(location, name);
+ if(context.isExpandedFromWildcard(this))
+ context.addExpandedFromWildcard(resolved);
+ return resolved;
}
@Override
@Override
public Expression resolveAsPattern(TranslationContext context) {
- return context.resolvePattern(this);
+ Expression resolved = context.resolvePattern(this);
+ if(context.isExpandedFromWildcard(this))
+ context.addExpandedFromWildcard(resolved);
+ return resolved;
}
@Override
package org.simantics.scl.compiler.elaboration.expressions;
+@FunctionalInterface
public interface VariableProcedure {
void execute(long location, Variable variable);
}
+import "JavaBuiltin" as Java
+
importJava "java.util.Iterator" where
data T a
loop ()
else ()
+@inline
+iterI :: (Integer -> a -> <e> b) -> T a -> <Proc,e> ()
+iterI f it = loop 0
+ where
+ loop i =
+ if hasNext it
+ then do
+ f i (next it)
+ loop (Java.iadd i 1)
+ else ()
+
@inline
iterB :: (a -> <e> Boolean) -> T a -> <Proc,e> Boolean
iterB f it = loop ()
"""
class (Monad m) => MonadZero m where
mzero :: m a
+ mfilter :: (a -> Boolean) -> m a -> m a
+
+ mfilter p m = m >>= (\x -> if p x then return x else mzero)
"Injects a boolean test to a type beloning to `MonadZero`."
guard :: MonadZero m => Boolean -> m ()
instance MonadE [] where
bindE l f = concatMap f l
+
+/// MZeroE ///
+
+class (MonadE m, MonadZero m) => MonadZeroE m where
+ filter :: (a -> <e> Boolean) -> m a -> <e> m a
+
+ filter p m = m `bindE` (\x -> if p x then return x else mzero)
+instance MonadZeroE [] where
+ filter = filterList
+
+instance MonadZeroE Maybe where
+ filter p (Just x) | not (p x) = Nothing
+ filter _ m = m
+
/// Category ///
"Identity function."
`filter pred lst` returns those elements of `lst` that the predicate `pred` accepts. For example
filter (> 3) [1, 2, 3, 4, 5, 6] = [4, 5, 6]
-"""
+"""
@inline
-filter :: (a -> <e> Boolean) -> [a] -> <e> [a]
-filter p l = build (\empty cons -> foldl (\cur x -> if p x then cons cur x else cur) empty l)
+filterList :: (a -> <e> Boolean) -> [a] -> <e> [a]
+filterList p l = build (\empty cons -> foldl (\cur x -> if p x then cons cur x else cur) empty l)
"""
Takes those elements of the input list that match `(Just x)` and adds the contents to the resulting list. For example,
iterator :: T a -> Iterator.T a
@inline
-iter :: (a -> <e> ()) -> T a -> <e> ()
+iter :: (a -> <e> b) -> T a -> <e> ()
iter f s = runProc (Iterator.iter f (iterator s))
@inline
iterB :: (a -> <e> Boolean) -> T a -> <e> Boolean
iterB f s = runProc (Iterator.iterB f (iterator s))
+@inline
+iterI :: (Integer -> a -> <e> b) -> T a -> <e> ()
+iterI f s = runProc (Iterator.iterI f (iterator s))
+
@inline
fold :: (a -> b -> <e> a) -> a -> T b -> <e> a
fold f init s = runProc (Iterator.fold f init (iterator s))
+
+importJava "java.util.Collections" where
+ singleton :: a -> T a
+
+ @JavaName emptySet
+ empty :: T a
+
+importJava "gnu.trove.set.hash.THashSet" where
+ @JavaName "<init>"
+ fromList :: [a] -> T a
+
+importJava "java.util.ArrayList" where
+ @JavaName "<init>"
+ toList :: T a -> [a]
--- /dev/null
+import "Prelude"
+import "MSet" as MSet
+import "Set" as Set
+
+instance Functor Set.T where
+ fmap = map
+
+instance FunctorE Set.T where
+ map f set = runProc do
+ result = MSet.create ()
+ Set.iter (\x -> MSet.add result $ f x) set
+ MSet.freeze result
+
+ iter = Set.iter
+ iterI = Set.iterI
+
+instance Monad Set.T where
+ return = Set.singleton
+ (>>=) = bindE
+
+@private
+importJava "java.util.Set" where
+ @JavaName addAll
+ addAll' :: MSet.T a -> Set.T a -> <Proc> Boolean
+
+instance MonadE Set.T where
+ set `bindE` f = runProc do
+ result = MSet.create ()
+ Set.iter (\x -> addAll' result $ f x) set
+ MSet.freeze result
+
+instance MonadZero Set.T where
+ mzero = Set.empty
+
+instance MonadZeroE Set.T where
+ filter p set = runProc do
+ result = MSet.create ()
+ Set.iter (\x ->
+ if p x
+ then ignore $ MSet.add result x
+ else ()
+ ) set
+ MSet.freeze result
+
+instance (Show a) => Show (Set.T a) where
+ sb <+ set = do
+ sb << "{"
+ Set.iterI (\i x -> (if i > 0 then sb << ", " else sb) <+ x) set
+ sb << "}"
+
+instance Additive (Set.T a) where
+ zero = Set.empty
+ a + b = runProc do
+ result = MSet.create ()
+ Set.iter (MSet.add result) a
+ Set.iter (MSet.add result) b
+ MSet.freeze result
+ sum sets = runProc do
+ result = MSet.create ()
+ iter (Set.iter (MSet.add result)) sets
+ MSet.freeze result
\ No newline at end of file
+++ /dev/null
-import "Prelude"
-import "Set" as Set
-import "MSet" as MSet
-import "MList" as MList
-
-fromList :: [a] -> Set.T a
-fromList l = runProc (MSet.freeze $ MSet.fromList l)
-
-toList :: Set.T a -> [a]
-toList s = runProc do
- result = MList.createC (Set.size s)
- Set.iter (MList.add result) s
- MList.freeze result
\ No newline at end of file
include "File" as File
include "Serialization" as Serialization
include "Set" as Set
-include "SetUtils" as Set
+include "SetClasses"
//include "Map" as Map
include "MMap" as MMap
include "MSet" as MSet
when ?x <- ?y
then True
--
+3:10-3:12: Existential variable ?x is referred only once. Replace by _ if this is a wildcard.
3:10-3:18: Cannot solve the query.
+3:16-3:18: Existential variable ?y is referred only once. Replace by _ if this is a wildcard.
--
import "Prelude"
where
X ?x => Y ?y
--
+6:7-6:9: Existential variable ?x is referred only once. Replace by _ if this is a wildcard.
6:15-6:17: New existential variables can be defined only in queries.
\ No newline at end of file
Code Review / simantics / platform.git / commitdiff