Merge branch 'master' of git@github.com:johang88/haskellinjavascript

haskell.ast.js

@@ -35,6 +35,7 @@
             	      | Let Pattern Expression Expression
                	      | Case Expression [(Pattern, Expression)]
                       | VariableLookup Identifier
+		      | If Expression Expression Expression
 		      | Do [DoNotation]
 		      | List [Expression]
 		      | ArithmeticSequence Expression (Maybe Expression) (Maybe Expression)
@@ -152,6 +153,32 @@
             return this.identifier;
         };
     };
+    ast.If = function(ifExpr, thenExpr, elseExpr) {
+	expectType(ifExpr, ast.Expression);
+	expectType(thenExpr, ast.Expression);
+	expectType(elseExpr, ast.Expression);
+	this.ifExpr = ifExpr;
+	this.thenExpr = thenExpr;
+	this.elseExpr = elseExpr;
+	this.eval = function(env) {
+
+	};
+
+	this.stringify = function() {
+	    return "if " + this.ifExpr.stringify() + " then " + this.thenExpr.stringify() + " else " + this.elseExpr.stringify();
+	};
+
+	this.eval = function(env) {
+	    var expr = new interpreter.HeapPtr(new interpreter.Closure(env, this.ifExpr));
+	    var res = expr.dereference();
+	    if (new ast.PatternConstructor("True", []).match(env, expr)) {
+		return this.thenExpr;
+	    } else {
+		return this.elseExpr;
+	    }
+	};
+    };
+    ast.If.prototype = new ast.Expression();
     ast.Do = function(notations) {
 	expectTypeArray(notations, ast.DoNotation);
 	this.type="Do";

haskell.js

@@ -3,5 +3,6 @@ var haskell = {
     interpreter: {},
     ast: {},
     primitives: {},
-    utilities: {}
+    utilities: {},
+    typechecker: {}
 };

haskell.parser.js

@@ -501,7 +501,7 @@
 
         var if_action = function(p) {
             return action(p, function(ast) {
-                return ast;
+		    return new haskell.ast.If(ast[0], ast[1], ast[2]);
             });
         };
 

haskell.typechecker.js

@@ -0,0 +1,214 @@
+(function (typechecker, ast) {
+     ast.Num.prototype.infer = function(env) {
+	return new typechecker.Pred(
+	    "Num",
+	    env.newTVar(new typechecker.Star(), env));
+     };
+
+     ast.VariableLookup.prototype.infer = function(env) {
+	 if(env[this.identifier] != undefined) {
+	     return new typechecker.Pred("Num", new typechecker.TVar("a3", new typechecker.Star()));
+	 }
+     };
+
+     /*
+      * data Kind = Star | Kfun Kind Kind
+      *   deriving Eq
+      * 
+      */
+     typechecker.Star = function() {
+	 this.toString = function() { return "*"; };
+	 this.toStringNested = this.toString;
+     };
+     typechecker.Kfun = function(kind1, kind2) {
+	 this.kind1 = kind1;
+	 this.kind2 = kind2;
+	 this.toString = function() {
+	     return kind1.toStringNested() + "->" + kind2.toStringNested();
+	 };
+	 this.toStringNested = function() {
+	     return "(" + this.toString() + ")"; };
+     };
+
+     /*
+      * data Type = TVar Tyvar | TCon Tycon | TAp Type Type | TGen Int
+      *   deriving Eq
+      * 
+      */
+     typechecker.TVar = function(id, kind) {
+	 this.toString = function () {
+	     return this.id() + " (" + this.kind() + ")";
+	 };
+	 this.id = function () { return id; };
+	 this.kind = function() { return kind; };
+	 this.apply = function(subst) {
+	     if (subst[this] != undefined) {
+		 return subst[this];
+	     }
+	     return (new typechecker.TVar(this.id(), this.kind()));
+	 };
+	 this.tv = function() { return [tyvar]; };
+     };
+
+     /*
+      typechecker.newTVar = function(kind, env) {
+	 return new typechecker.TVar(env.nextName(), kind);
+     };
+      */
+
+     typechecker.TCon = function(id, kind) {
+	 this.id = function() { return id; };
+	 this.kind = function() { return kind; };
+	 this.apply = function(subst) { return this; };
+	 this.tv = function() { return []; };
+     };
+
+     typechecker.TAp = function(t1, t2) {
+	 this.kind = function() { return t1.kind().kind2;  };
+	 this.apply = function(subst) {
+	     return new typechecker.TAp(t1.apply(),t2.apply());
+	 };
+	 this.tv = function() {
+	     return [].concat(t1.tv()).concat(t2.tv()).unique();
+	 };
+     };
+     typechecker.TGen = function(id) {
+	 this.id = function() { return id; };
+	 this.apply = function(subst) { return this; };
+	 this.tv = function() { return []; };
+
+     };
+/*
+     typechecker.Class = function(ids, insts) {
+	 this.ids = function() { return ids; };
+	 this.insts = function() { return insts; };
+     };
+
+     typechecker.Inst = function() {
+	 
+     };
+*/
+
+     typechecker.Qual = function(preds, t) {
+	 this.pred = function() { return preds; };
+	 this.t = function() { return t; };
+     };
+
+     typechecker.Pred = function(class, type) {
+	 this.class = function() { return class; };
+	 this.type = function() { return type; };
+	 this.toString = function() {
+	     return this.class().toString() +
+		 " " + 
+		 this.type().id();
+	 };
+     };
+
+     typechecker.Scheme = function(kinds, qual) {
+	 this.kinds = function() { return kinds; };
+	 this.qual = function() { return qual; };
+	 this.freshInst = function() {};
+     };
+
+     typechecker.toScheme = function(type) {
+	 return new typechecker.Scheme([], new typechecker.Qual([], type));
+     };
+
+/*
+     typechecker.ClassEnv = function(classes, defaults) {
+	 this.classes = function() { return classes; };
+	 this.defaults = function() { return defaults; };
+	 this.super = function(id) {
+	     return this.classes(id).ids();
+	 };
+	 this.insts = function(id) {
+	     return this.classes(id).insts();
+	 };
+     };
+*/
+
+     /*
+      * Some built-in types
+      * 
+      */
+     typechecker.tUnit
+	 = new typechecker.TCon("()", new typechecker.Star());
+     typechecker.tChar
+	 = new typechecker.TCon("Char", new typechecker.Star());
+     typechecker.tInt
+	 = new typechecker.TCon("Int", new typechecker.Star());
+     typechecker.tInteger
+	 = new typechecker.TCon("Integer", new typechecker.Star());
+     typechecker.tFloat
+	 = new typechecker.TCon("Float", new typechecker.Star());
+     typechecker.tDouble
+	 = new typechecker.TCon("Double", new typechecker.Star());
+
+     typechecker.tList = new typechecker.TCon(
+	 "[]",
+	 new typechecker.Kfun(new typechecker.Star(),
+			      new typechecker.Star()));
+     typechecker.tArrow = new typechecker.TCon(
+	 "(->)",
+	 new typechecker.Kfun(
+	     new typechecker.Star(),
+	     new typechecker.Kfun(
+		 new typechecker.Star(),
+		 new typechecker.Star())));
+     typechecker.tTuple2 = new typechecker.TCon(
+	 "(,)",
+	 new typechecker.Kfun(
+	     new typechecker.Star(),
+	     new typechecker.Kfun(
+		 new typechecker.Star(),
+		 new typechecker.Star())));
+     /*
+      * Substitutions
+      * 
+      * type Subst [(Tyvar, Type)]
+      * 
+      * We use a map (JavaScript Object) instead
+      * 
+      */
+/*
+     typechecker.nullSubst = {};
+     typechecker.singleSubst = function(u,t) { return {u: t}; };
+     typechecker.composeSubst = function(s1, s2) {
+	 var s3 = {};
+	 for(var u in s2) {
+	     s3[u] = s2[u].apply(s1);
+	 }
+	 for(var u in s1) {
+	     s3[u] = s1[u];
+	 }
+	 return s3;
+     };
+*/
+
+     typechecker.NameGen = function(startAt) {
+	 this.next = function(env) {
+	     while(env["a" + startAt] != undefined) {
+		 startAt++;
+	     }
+	     return "a" + startAt;
+	 };
+     };
+
+     typechecker.Environment = function(init) {
+	 if(init != undefined) {
+	     for(i in init) {
+		 this[i]=init[i];
+	     }
+	 }
+	 var gen = new typechecker.NameGen(1);
+	 this.nextName = function() { return gen.next(this); };
+	 this.newTVar = function (kind) {
+	     return new typechecker.TVar(this.nextName(), kind);
+	 };
+     };
+
+     typechecker.emptyEnv = function() {
+	 return new typechecker.Environment();
+     };
+
+}) (haskell.typechecker, haskell.ast);

hs/Prelude.hs

@@ -44,6 +44,16 @@ foldr1 f xs = case xs of
     [x] -> x
     (x:xs) -> f x $ foldr1 f xs
 
+foldr _ b [] = b
+foldr f b (x:xs) = foldr f (f x b) xs
+
+foldl _ b [] = b
+foldl f b (x:xs) = foldl f (f b x) xs
+
+reverse = foldl (\a b -> b:a) []
+
+flip f a b = f b a
+
 filter _ [] = []
 filter f (x:xs ) | f x = x : filter f xs
                  | otherwise = filter f xs

typecheckertests.html

@@ -0,0 +1,26 @@
+<html xmlns="http://www.w3.org/1999/xhtml">
+  <head>
+    <script src="lib/jsparse.js" type="text/javascript"></script> 
+    <script src="haskell.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> 
+    <script src="haskell.typechecker.js" type="text/javascript"></script> 
+    <script type="text/javascript" src="typecheckertests.js" />
+    <script type="text/javascript">
+      /* fireunit.ok(true, "Passing test result");
+      fireunit.ok(false, "Failing test result.");
+      fireunit.compare("expected data", "expected data",
+      "Passing verification of expected and actual input.");
+      fireunit.compare("<div>expected</div>", "<div>actual</div>",
+      "Failing verification of expected and actual input.");
+      
+      // Wait for asynchronous operation.
+      setTimeout(function(){
+      // Finish test
+      fireunit.testDone();
+      }, 1000); */
+    </script>
+  </head>
+  <body/>
+</html>