Browse files

merge

  • Loading branch information...
2 parents 3b63c76 + faf1a00 commit bd186b4587bac32ba3dbb94c040f29aa08ac39d8 Johan Gustafsson committed May 30, 2010
Showing with 124 additions and 24 deletions.
  1. +70 −1 haskell.ast.js
  2. +2 −3 haskell.hiji.js
  3. +51 −20 haskell.typechecker.js
  4. +1 −0 typecheckertests.html
View
71 haskell.ast.js
@@ -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);
@@ -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();
+ };
/*
@@ -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]
@@ -89,7 +133,7 @@
return this.desugar().stringify();
};
ast.Expression.prototype.desugar = function() {
- return this;
+ return undefined;
};
ast.Constant = function(value) {
@@ -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);
@@ -215,6 +274,7 @@
};
};
ast.If.prototype = new ast.Expression();
+
ast.Do = function(notations) {
expectTypeArray(notations, ast.DoNotation);
this.type="Do";
@@ -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(){};
@@ -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();
View
5 haskell.hiji.js
@@ -104,6 +104,7 @@ commands[":type"] = "TYPE";
}
input.attr("value","");
+ $('.input', this).replaceWith(makeEntered(modules, line));
if(isCommand(line)){
runCommand(line, input, line);
}else
@@ -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();
View
71 haskell.typechecker.js
@@ -1,3 +1,4 @@
+
(function (typechecker, ast) {
var inject = function(arr, f, acc) {
@@ -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),
@@ -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,
@@ -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) {
@@ -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);
}
);
@@ -209,7 +212,7 @@
var infert = injectRight(
ts,
function(t, acc) {
- typechecker.fn(t, acc);
+ return typechecker.fn(t, acc);
},
rt
);
@@ -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";
};
@@ -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
@@ -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(
@@ -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());
@@ -663,7 +676,7 @@
return this.type().hnf();
};
this.toString = function() {
- return this.id() + " => " + this.type();
+ return this.id() + " " + this.type();
};
};
@@ -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) {
@@ -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;
+ };
};
@@ -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) {
@@ -1047,5 +1071,12 @@
);
};
};
+
+ typechecker.emptyEnv = function() {
+ return new typechecker.Environment(
+ new typechecker.Assumps(),
+ new typechecker.Subst(),
+ new typechecker.NameGen());
+ };
}) (haskell.typechecker, haskell.ast);
View
1 typecheckertests.html
@@ -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>

0 comments on commit bd186b4

Please sign in to comment.