/** @see jaskell.compiler.JaskellVisitor#visit(Application) */
public Object visit(Application a) {
try {
/* get type of function */
Expression fun = a.getFunction();
/* get type deduced from arguments */
LinkedList l = new LinkedList();
Iterator it = a.getArgs().iterator();
while (it.hasNext()) {
Expression e = (Expression) it.next();
l.add((Type) e.visit(this));
}
Type vt = TypeFactory.freshBinding();
Type ft = Types.fun(l, vt);
log.finer("TypeChecker => In application " + a + ", type is " + ft);
/* apply substitution on both types */
ft = subst.substitute(ft);
/* try to unify function type and constructed types */
Type t = (Type) fun.visit(this);
log.finer("In application, function " + fun + " :: " + t);
t = subst.substitute(t);
log.finer("In application, trying to unify function type " + t + " with body " + ft);
/*
* TODO : problem with unification of constrained types
*/
TypeApplication uni = (TypeApplication) tu.unify(t, ft, typeVariablesMap);
/* sets type of functional expression - this allows
* polymorphic functions to receive several types
* in the same code */
// fun.setType(uni);
/* apply arguments type to compute return type */
log.finer("Done unify application :" + uni);
it = PrimitiveType.functionIterator(uni);
Iterator it2 = l.iterator();
TypeApplication ut = uni;
while (it2.hasNext()) {
/* type of argument */
Type at = (Type) it2.next();
ut = (TypeApplication) it.next();
/* try unification */
tu.unify(((TypeApplication) ut.getDomain()).getRange(), at, new HashMap(typeVariablesMap));
}
ft = subst.substitute(ft);
fun.setType(ft);
log.finer("Setting type of functional element [" + fun + "] to :" + ft);
a.setType(ut.getRange());
return ut.getRange();
} catch (TypeError te) {
if (te.getLineCol() == null) te.setLineCol(a.getTag("source"));
throw te;
}
}
/** @see jaskell.compiler.JaskellVisitor#visit(QualifiedVariable) */
public Object visit(QualifiedVariable a) {
Module mod = null;
Iterator it = a.getPath().iterator();
while (it.hasNext()) {
String mname = (String) it.next();
if (mod != null) mod = (Module) mod.lookup(mname);
else mod = (Module) Module.getToplevels().get(mname);
}
/* module found */
if (mod != null) {
Expression def = mod.lookup(a.getName());
if (def == null) throw new CompilerException("Unknown variable " + a.getName());
Type t = def.getType();
if (t == null) t = (Type) def.visit(this);
/* as it is the case for variable, we assume
* that a defined symbol may be overloaded (only for primitive types)
* so we return a type variable and defers choice of
* symbol to a later stage
*/
a.setType(t);
return t;
}
throw new CompilerException("Unable to find module needed for variable " + a.getName());
}
/*
* (non-Javadoc)
*
* @see jaskell.compiler.JaskellVisitor#visit(jaskell.compiler.core.Module)
*/
public Object visit(Namespace a) {
/* set current namespace */
ns = a;
/*
* visit definitions We set an infinite loop to cope with modifications
* introduced by visiting sub expressions. When something is modified -
* through lift - we restart the whole process. TODO : change this to defer
* registering new bindings at end
*/
while (true) {
try {
Iterator it = a.getAllBindings().entrySet().iterator();
while (it.hasNext()) {
Map.Entry entry = (Map.Entry) it.next();
String functionName = (String) entry.getKey();
Expression def = (Expression) entry.getValue();
if (def instanceof Abstraction)
((Abstraction) def).setClassName(ns.getName() + "." + functionName);
log.finest("Analyzing lifting for " + functionName);
lift = false;
entry.setValue((Expression) def.visit(this));
}
break;
} catch (ConcurrentModificationException cmex) {
/* restart the process */
}
}
return a;
}
/*
* Definitions in the let block are lifted to top-level and the corresponding
* references in the body are replaced by new definitions.
*
* @see jaskell.compiler.JaskellVisitor#visit(jaskell.compiler.core.Let)
*/
public Object visit(Let let) {
HashMap subst = new HashMap(); /* substitution map */
Set lambdas = new HashSet(); /* newly created toplevels ? */
Iterator it = let.getBindings().entrySet().iterator();
/* first lift all definitions in this let */
while (it.hasNext()) {
Map.Entry entry = (Map.Entry) it.next();
String name = (String) entry.getKey();
Expression e = (Expression) entry.getValue();
/* reset lift flag */
lift = false;
Expression ndef = (Expression) e.visit(this);
ndef.setParent(let);
/* lift new definition */
Set captured = new HashSet();
CaptureCollector cc = new CaptureCollector(captured);
ndef.visit(cc);
String vname;
try {
vname = lift(ndef, captured);
lambdas.add(vname);
/*
* store new application spine in a map for later substitution
*/
subst.put(name, applyLifted(vname, captured));
} catch (SymbolException e1) {
e1.printStackTrace();
}
}
/* second, replace old occurences in new definitions */
it = lambdas.iterator();
while (it.hasNext()) {
String n = (String) it.next();
Expression e;
try {
e = (Expression) ns.resolve(n);
ns.rebind(n, (Expression) e.visit(new Substitution(subst)));
} catch (SymbolException e1) {
// TODO Auto-generated catch block
e1.printStackTrace();
}
}
/* thirs, replace occurences in body of let and return it */
return let.getBody().visit(new Substitution(subst));
}
/*
* (non-Javadoc)
*
* @see jaskell.compiler.JaskellVisitor#visit(jaskell.compiler.core.Alternative)
*/
public Object visit(Alternative a) {
Iterator it = a.getChoices();
while (it.hasNext()) {
Map.Entry entry = (Map.Entry) it.next();
Expression body = (Expression) entry.getValue();
entry.setValue(body.visit(this));
}
return a;
}
/** @see jaskell.compiler.JaskellVisitor#visit(Variable) */
public Object visit(Variable a) {
Type ret = null;
String vname = a.getName();
Expression def = a.lookup(vname);
if (def == null) // unknown symbol
throw new CompilerException("Unknown variable " + vname);
else ret = (Type) def.visit(this);
a.setType(ret);
return ret;
}
/*
* (non-Javadoc)
*
* @see jaskell.compiler.JaskellVisitor#visit(jaskell.compiler.core.Application)
*/
public Object visit(Application a) {
/* visit function */
a.setFunction((Expression) a.getFunction().visit(this));
/* visit all bodies of alternative */
List it = a.getArgs();
for (int i = 0; i < it.size(); i++) {
Expression e = (Expression) it.get(i);
it.set(i, e.visit(this));
}
return a;
}
/**
* Returns null or throws a TypeError if type cannot be inferred for any definition found.
* Verifies that main symbol in Main module is typed as <code>IO ()</code>.
*
* @see jaskell.compiler.JaskellVisitor#visit(Module)
*/
public Object visit(Namespace a) {
// visit definitions
Iterator it = a.getAllBindings().entrySet().iterator();
while (it.hasNext()) {
Map.Entry entry = (Map.Entry) it.next();
String name = (String) entry.getKey();
Expression def = (Expression) entry.getValue();
Type type = (Type) def.visit(this);
def.setType(type);
log.finer("TypeChecker => END Visiting " + name);
}
log.finer("Substitution map = " + typeVariablesMap);
return null;
}
/** @see jaskell.compiler.JaskellVisitor#visit(Let) */
public Object visit(Let a) {
Type ret = a.getType();
if (ret != null) return ret;
// visit definitions
Iterator it = a.getBindings().entrySet().iterator();
while (it.hasNext()) {
Map.Entry entry = (Map.Entry) it.next();
String name = (String) entry.getKey();
Expression def = (Expression) entry.getValue();
log.finer("Visiting " + name);
def.setType((Type) def.visit(this));
}
// visit body
ret = (Type) a.getBody().visit(this);
a.setType(ret);
// return type of body
return ret;
}
/** @see jaskell.compiler.JaskellVisitor#visit(Alternative) */
public Object visit(Alternative a) {
try {
Type tex = (Type) a.getExpression().visit(this);
log.finer("In alternative, type of expression " + a.getExpression() + " is " + tex);
/* set type of bound variable */
LocalBinding lb = a.getBinding();
if (lb != null) lb.setType(tex);
/* visit type of alternatives */
Iterator it = a.getChoices();
Type ptype = tex;
Type btype = null;
while (it.hasNext()) {
Map.Entry entry = (Map.Entry) it.next();
/* checkt type of pattern */
Type pt = (Type) ((Pattern) entry.getKey()).visit(this);
if (ptype == null) ptype = pt;
else ptype = tu.unify(pt, ptype, typeVariablesMap);
log.finer("In alternative, unifying pattern type " + pt + " to " + ptype);
Expression expr = (Expression) entry.getValue();
/* check type of body */
Type bt = (Type) expr.visit(this);
// /* apply substitution with type variables from pattern */
// TypeSubstitution ts = new TypeSubstitution(typeVariablesMap);
// expr.visit(ts);
if (btype == null) btype = bt;
else btype = tu.unify(bt, btype, typeVariablesMap);
log.finer("In alternative, unifying body type " + bt + " to " + btype);
}
/* visit default choice */
Type deft = (Type) a.getWildcard().visit(this);
a.setType(btype);
return btype;
} catch (TypeError te) {
if (te.getLineCol() == null) te.setLineCol(a.getTag("source"));
throw te;
}
}
/** @see jaskell.compiler.JaskellVisitor#visit(Abstraction) */
public Object visit(Abstraction a) {
try {
Type t = a.getType();
if (t != null) return subst.substitute(t);
log.finest("Visiting abstraction : " + a);
Expression body = a.getBody();
/* duplicate bindings map to assign types to variables */
pushContext(a.getBindings());
/* create fresh type variables as type for each bound
* variable */
Iterator it = namesMap.values().iterator();
LinkedList tl = new LinkedList();
while (it.hasNext()) {
LocalBinding name = (LocalBinding) it.next();
Type vt = TypeFactory.freshBinding();
name.setType(vt);
tl.add(vt);
}
Type tv = TypeFactory.freshBinding();
/* create type with all variables for function */
Type ft = Types.fun(tl, tv);
log.finer("In abstraction, setting type to " + ft);
a.setType(ft);
/* analyze body */
Type bt = (Type) body.visit(this);
/* unify return type of function with type of body */
Type ret = tu.unify(PrimitiveType.getReturnType(ft), bt, typeVariablesMap);
TyvarSubstitution tys = new TyvarSubstitution(typeVariablesMap);
tys.visit(a);
log.finer("Done abstraction, setting type from " + ft + " to " + a.getType());
popContext();
return a.getType();
} catch (TypeError te) {
if (te.getLineCol() == null) te.setLineCol(a.getTag("source"));
throw te;
}
}
