desugar type bindings

closure_conversion.js

@@ -106,7 +106,7 @@ function closure_convert(stx) {
   return new rep.Closure(bound_vars, free_variables, stx, []);
 }
 
-function closure_convert_all(stx, env) {
+function closure_convert_all(stx) {
   var closure;
   switch (stx.exprType) {
     case "Let":
@@ -151,8 +151,8 @@ function test(src) {
   console.log(JSON.stringify(closure_convert_all(ast), null, 4));
 }
 
-console.log(pprint.pprint(parser.parse(pprint.pprint(parser.parse("if something then if a then if b then c else d else rtrrt else some_other_thing")[0]))[0]));
-console.log(pprint.pprint(parser.parse("def main (print let { a = def {f = (lambda a b -> (a+b))} f} (a 2 3))")[0]));
+//console.log(test(pprint.pprint(parser.parse(pprint.pprint(parser.parse("if something then if a then if b then c else d else rtrrt else some_other_thing")[0]))[0])));
+console.log(pprint.pprint(parser.parse("defop 1 Right (a $# b) (a - b) def main (4 $# b $# c)")[1]));
 module.export = {
   test : test,
   closureConvert : closure_convert_all

desugar.js

@@ -26,6 +26,7 @@ function desugarDefFunc(def) {
                                def.body));
 }
 
+
 function curryFunc(ps, body) {
   if (_.isEmpty(ps)) {
     return desugar(body);
@@ -55,6 +56,10 @@ function desugar(stx) {
     case "Name":
       return stx;
     case "Application":
+      if (stx.func.ident === "::") {
+        //It's a type binding
+        return desugarTypeBinding(stx);
+      }
       if ((stx.func.ident === "-" ||
           stx.func.ident === "+") &&
           stx.p) {

representation.js

@@ -1,3 +1,6 @@
+var errors = require("./errors.js");
+var _ = require("underscore");
+
 var Expression = {
 	display :
 		function() {
@@ -6,18 +9,24 @@ var Expression = {
 	type :
 		function () {
 			return this.exprType;
-		},
-	unify :
+		}
+};
+
+var TypeExpression = {
+  unify :
 		function (t) {
-			if (this.exprType === t.exprType) {
-				return t.exprType;
+			if (this.expr === t.expr) {
+				return t.expr;
 			}
 			else {
-				console.log("Could not unify " + this.exprType + " with " + t.exprType);
+				console.log("Could not unify " + this.expr + " with " + t.expr);
 			}
-		}
+		},
+  isTypeExpr : true
 };
 
+var isTypeExpr = _.property("isTypeExpr");
+
 function Closure(bound_vars, free_vars, body, env) {
   this.bound_vars = bound_vars;
   this.free_vars = free_vars;
@@ -163,17 +172,37 @@ function If(condition, thenexp, elseexp) {
 }
 
 function TypeVar(name) {
+  this.exprtype = "TypeVar";
   this.name = name;
   return this;
 }
 
+TypeVar.prototype = TypeExpression;
+
 function TypeOp(name, params, body) {
+  if (!_.every(params, _.compose(
+                          _.partial(_.isEqual, "TypeVar"),
+                          _.property("exprtype")))) {
+    throw errors.JInternalError(
+        "Parameters to a type operator must be type variables"
+    );
+  }
   this.name = name;
   this.params = params;
   this.body = body;
   return this;
 }
 
+TypeOp.prototype = TypeExpression;
+
+function TypeBinding(expression, type) {
+  this.expr = expression;
+  this.type = type;
+  return this;
+}
+
+TypeBinding.prototype = TypeExpression;
+
 //Applies the function ``name'' to the list of parameters
 function makeApp(name, parameters) {
 	if (parameters) {
@@ -184,7 +213,6 @@ function makeApp(name, parameters) {
 	else {
 		return new App(name);
 	}
-
 }
 
 function makeGensym() {
@@ -221,25 +249,27 @@ OPInfo = {"+" : [3, "Left"],
           "," : [1, "Left"]};
 
 module.exports =
-   { IntT   : IntT,
-  FloatT : FloatT,
-  StrT   : StrT,
-  BoolT  : BoolT,
-  ListT  : ListT,
-  FuncT  : FuncT,
-  App    : App,
-  Name   : Name,
-  Def    : Def,
-  OpT   : OpT,
-  OPInfo : OPInfo,
-  makeApp : makeApp,
-  If      : If,
-   DefFunc : DefFunc,
-   UnaryOp : UnaryOp,
-   Nil : Nil,
-   LetExp : LetExp,
-   gensym : gensym,
-   TypeVar : TypeVar,
-   TypeOp : TypeOp,
-   Closure : Closure
+   {
+     IntT   : IntT,
+     FloatT : FloatT,
+     StrT   : StrT,
+     BoolT  : BoolT,
+     ListT  : ListT,
+     FuncT  : FuncT,
+     App    : App,
+     Name   : Name,
+     Def    : Def,
+     OpT   : OpT,
+     OPInfo : OPInfo,
+     makeApp : makeApp,
+     If : If,
+     DefFunc : DefFunc,
+     UnaryOp : UnaryOp,
+     Nil : Nil,
+     LetExp : LetExp,
+     gensym : gensym,
+     TypeVar : TypeVar,
+     TypeOp : TypeOp,
+     TypeBinding : TypeBinding,
+     Closure : Closure
    };