Skip to content

Commit

Permalink
merge
Browse files Browse the repository at this point in the history
  • Loading branch information
Johan Gustafsson committed May 30, 2010
2 parents 3b63c76 + faf1a00 commit bd186b4
Show file tree
Hide file tree
Showing 4 changed files with 124 additions and 24 deletions.
71 changes: 70 additions & 1 deletion haskell.ast.js
Expand Up @@ -42,12 +42,18 @@
this.name = name;
};
ast.TypeVariable.prototype = new ast.Type();
ast.TypeVariable.prototype.stringify = function() {
return this.name;
};

ast.TypeConstructor = function(name) {
expectTypeOf(name, "string");
this.name = name;
};
ast.TypeConstructor.prototype = new ast.Type();
ast.TypeConstructor.prototype.stringify = function() {
return this.name;
};

ast.TypeApplication = function(t1, t2) {
expectType(t1, ast.Type);
Expand All @@ -56,12 +62,49 @@
this.t2 = t2;
};
ast.TypeApplication.prototype = new ast.Type();
ast.TypeApplication.prototype.stringify = function() {
return this.t1.stringify() + " " + this.t2.stringify();
};

ast.TypeTupple = function(size) {
expectTypeOf(size, "number");
this.size = size;
};
ast.TypeTupple.prototype = new ast.Type();
ast.TypeTupple.prototype.stringify = function() {
return "(" + (new Array(this.size)).join(",") + ")";
};

/*
data Constraint = Constraint Identifier Identifier
*/

ast.Constraint = function(typeclass, typevar) {
expectTypeOf(typeclass, "string");
expectTypeOf(typevar, "string");
this.typeclass = typeclass;
this.typevar = typevar;
};
ast.Constraint.prototype.stringify = function() {
return this.typeclass + " " + this.typevar;
};

/*
data TypeConstraint = TypeConstraint [Constraint] Type
*/
ast.TypeConstraint = function(constraints, type) {
expectTypeArray(constraints, ast.Constraint);
expectType(type, ast.Type);
this.constraints = constraints;
this.type = type;
};
ast.Constraint.prototype.stringify = function() {
var constraints = this.constraints.map(function(p) { return p.stringify(); }).join(", ");
if (constraints.length > 0) {
constraints = "(" + constraints + ") => ";
}
return predsString + this.type.stringify();
};


/*
Expand All @@ -71,6 +114,7 @@
| Let Pattern Expression Expression
| Case Expression [(Pattern, Expression)]
| VariableLookup Identifier
| ExpressionTypeConstraint Expression TypeConstraint
| If Expression Expression Expression
| Do [DoNotation]
| List [Expression]
Expand All @@ -89,7 +133,7 @@
return this.desugar().stringify();
};
ast.Expression.prototype.desugar = function() {
return this;
return undefined;
};

ast.Constant = function(value) {
Expand Down Expand Up @@ -189,6 +233,21 @@
return this.identifier;
};
};
ast.ExpressionTypeConstraint = function(expr, type) {
expectType(expr, ast.Expression);
expectType(type, ast.TypeConstraint);
this.expr = expr;
this.type = type;
this.eval = function(env) {
return this.expr;
};

this.stringify = function() {
return this.expr.stringify() + " :: " + this.type.stringify();
};
};
ast.ExpressionTypeConstraint.prototype = new ast.Expression();

ast.If = function(ifExpr, thenExpr, elseExpr) {
expectType(ifExpr, ast.Expression);
expectType(thenExpr, ast.Expression);
Expand All @@ -215,6 +274,7 @@
};
};
ast.If.prototype = new ast.Expression();

ast.Do = function(notations) {
expectTypeArray(notations, ast.DoNotation);
this.type="Do";
Expand Down Expand Up @@ -459,6 +519,7 @@
data Declaration = Variable Pattern Expression
| Function Identifier [Pattern] [(Guard, Expression)]|Expression
| Data Identifier [TVar] [Constructor]
| TypeConstraintDeclaration [Identifier] TypeConstraint
*/

ast.Declaration = function(){};
Expand Down Expand Up @@ -519,6 +580,14 @@
};
};

ast.TypeConstraintDeclaration = function(funs, type) {
// expectTypeArrayOf(funs, "string");
expectType(type, ast.TypeConstraint);
this.funs = funs;
this.type = type;
};
ast.TypeConstraintDeclaration.prototype = new ast.Declaration();

ast.Variable.prototype = new ast.Declaration();
ast.Data.prototype = new ast.Declaration();
ast.Function.prototype = new ast.Declaration();
Expand Down
5 changes: 2 additions & 3 deletions haskell.hiji.js
Expand Up @@ -104,6 +104,7 @@ commands[":type"] = "TYPE";
}
input.attr("value","");

$('.input', this).replaceWith(makeEntered(modules, line));
if(isCommand(line)){
runCommand(line, input, line);
}else
Expand All @@ -114,14 +115,12 @@ commands[":type"] = "TYPE";
printArea = $("ol", this);
env = evaluateHaskell(line, env);
console.log("%o", env);
// var output = makeOutput(result);
// $('.input', this).after(output).replaceWith(newLine);
$("ol",this).append(makeInput(modules));
}
catch(e) {
console.log("%o", e);
};
}
$("ol",this).append(makeInput(modules));

//set focus
$("input:text:visible:first").focus();
Expand Down
71 changes: 51 additions & 20 deletions haskell.typechecker.js
@@ -1,3 +1,4 @@

(function (typechecker, ast) {

var inject = function(arr, f, acc) {
Expand Down Expand Up @@ -155,7 +156,6 @@
var fInf = this.func.infer(env);
var argInf = this.arg.infer(env);
var t = env.newTVar(new typechecker.Star());
// return argInf.type;
env.unify(typechecker.fn(argInf.type, t), fInf.type);
return {
preds: fInf.preds.concat(argInf.preds),
Expand All @@ -165,21 +165,19 @@

ast.Case.prototype.infer = function(env) {
var condT = this.expr.infer(env);
env.unify(condT,
typechecker.tBool);

var tp = env.newTVar(new typechecker.Star());
var te = env.newTVar(new typechecker.Star());
var ps = [];
env.unify(tp, condT.type);
var ps = condT.preds;
this.cases.map(
function(c) {
var patT = c[0].infer(env);
env.unify(tp, patT.type);
var childEnv = env.createChild();
childEnv.addMany(patT.assumps);
var exprtT = c[1].infer(childEnv);
env.unify(tp, patT);
env.unify(te, exprT);
ps = ps.concat(patT.preds).concat[exprT.preds];
var exprT = c[1].infer(childEnv);
env.unify(te, exprT.type);
ps = ps.concat(patT.preds).concat(exprT.preds);
});
return {
preds: ps,
Expand All @@ -188,7 +186,12 @@
};

ast.ConstantPattern.prototype.infer = function(env) {
return this.value.infer(env);
var inf = this.value.infer(env);
return {
preds: inf.preds,
assumps: [],
type: inf.type
};
};

ast.PatternConstructor.prototype.infer = function(env) {
Expand All @@ -200,7 +203,7 @@
function(pat) {
var patInf = pat.infer(env);
ps = ps.concat(patInf.preds);
ts.push(patInf.type);
ts = ts.concat([patInf.type]);
as = as.concat(patInf.assumps);
}
);
Expand All @@ -209,7 +212,7 @@
var infert = injectRight(
ts,
function(t, acc) {
typechecker.fn(t, acc);
return typechecker.fn(t, acc);
},
rt
);
Expand Down Expand Up @@ -410,10 +413,13 @@
});
};
this.mgu = function(otherType) {
if(otherType.type() == "TVar") {
return otherType.mgu(this);
}
if(otherType.type() == "TAp") {
var s1 = this.t1().mgu(otherType.t1());
var s2 = this.t2().apply(s1).mgu(otherType.t2().apply(s1));
return s1.compose(s2);
return s2.compose(s1);
}
throw "types do not unify";
};
Expand Down Expand Up @@ -492,6 +498,9 @@
typechecker.Subst = function() {
var mappings = {};
this.add = function(from, to) {
if(this.exists(to)) {
to = to.apply(this);
}
mappings[from.id()] = {
from: from,
to: to
Expand Down Expand Up @@ -520,12 +529,11 @@
return acc.add(from, to);
},
new typechecker.Subst());
otherSubst.inject(
return otherSubst.inject(
function(from, to, acc) {
return acc.add(from, to.apply(curSubst));
},
newSubst);
return newSubst;
};
this.merge = function(otherSubst) {
var newSubst = this.inject(
Expand Down Expand Up @@ -630,7 +638,12 @@
typechecker.Pred = function(id, type) {
this.id = function() { return id; };
this.type = function() { return type; };
this.apply = function(subst) { return this.type().apply(subst); };
this.apply = function(subst) {
return new typechecker.Pred(
this.id(),
this.type().apply(subst)
);
};
this.mguPred = function(otherPred) {
if(this.id() == otherPred.id()) {
return this.type().mgu(otherPred.type());
Expand Down Expand Up @@ -663,7 +676,7 @@
return this.type().hnf();
};
this.toString = function() {
return this.id() + " => " + this.type();
return this.id() + " " + this.type();
};
};

Expand Down Expand Up @@ -712,7 +725,7 @@
} : parent;
var as = {};
this.add = function(a) {
as[a.id()] = a.scheme();
as[a.id()] = a;
return this;
};
this.addMany = function(as) {
Expand All @@ -725,13 +738,21 @@
};
this.lookup = function(id) {
if(as[id] != undefined) {
return as[id];
return as[id].scheme();
}
return parent.lookup(id);
};
this.createChild = function() {
return new typechecker.Assumps(this);
};
this.toString = function() {
var str = "";
as.map(
function(a) {
str += a.id() + "::" + a.scheme().toString() + ",";
});
return str;
};
};


Expand Down Expand Up @@ -1022,8 +1043,11 @@
return subst;
};
this.unify = function(t1, t2) {
var s = this.getSubst();
var newSubst = t1.apply(
this.getSubst()).mgu(t2.apply(this.getSubst()));
s
).mgu(
t2.apply(s));
this.extSubst(newSubst);
};
this.newTVar = function(kind) {
Expand All @@ -1047,5 +1071,12 @@
);
};
};

typechecker.emptyEnv = function() {
return new typechecker.Environment(
new typechecker.Assumps(),
new typechecker.Subst(),
new typechecker.NameGen());
};

}) (haskell.typechecker, haskell.ast);
1 change: 1 addition & 0 deletions typecheckertests.html
Expand Up @@ -2,6 +2,7 @@
<head>
<script src="lib/jsparse.js" type="text/javascript"></script>
<script src="haskell.js" type="text/javascript"></script>
<script src="haskell.utilities.js" type="text/javascript"></script>
<script src="haskell.ast.js" type="text/javascript"></script>
<script src="haskell.parser.js" type="text/javascript"></script>
<script src="haskell.interpreter.js" type="text/javascript"></script>
Expand Down

0 comments on commit bd186b4

Please sign in to comment.