Merge pull request #15 from oftn/master

merge OFTN version

desugar.js

@@ -57,6 +57,14 @@ function sugarTypeApp(stx) {
   return new typ.TypeApp(expression, type);
 }
 
+function desugarDefType(stx) {
+  var result;
+  result = new typ.DefType(desugar(stx.lhs), desugar(stx.rhs));
+  result.linenum = stx.linenum;
+  result.charnum = stx.charnum;
+  return result;
+}
+
 
 function desugar(stx) {
  var typeExpTest;
@@ -71,6 +79,8 @@ function desugar(stx) {
       return desugarDefFunc(stx);
     case "Definition":
       return new typ.Def(stx.ident, desugar(stx.val));
+    case "TypeDefinition":
+      return desugarDefType(stx);
     case "Name":
       return stx;
     case "Application":

example.jl

@@ -1,6 +1,8 @@
 defop 2 Left (a ++ b)
  (a - b)
 
+deftype Foo (A -> B)
+
 (qat :: A -> b)
 def tdeftype (lambda a b c -> (a + b))
 

parse.js

@@ -374,7 +374,7 @@ function parseDefType(tokens, linenum, charnum) {
     return parseDataType(tokens, linenum, charnum);
   }
 
-  if (notFollowedBy(tokens, ["constructor"]. linenum, charnum)) {
+  if (notFollowedBy(tokens, ["constructor"], linenum, charnum)) {
     throw error.JSyntaxError(linenum,
                              charnum,
                              "deftype must be followed by a single constructor" +
@@ -400,6 +400,8 @@ function parseDefType(tokens, linenum, charnum) {
                                rhs.charnum,
                                "was expecting an application or type operator on the right-hand side of a type definition");
     }
+    result = addSrcPos(new typ.DefType(lhs, rhs), tokens, linenum, charnum);
+    return result;
   }
 }
 
@@ -737,6 +739,9 @@ function parse(tokens) {
            toktype === "let") {
     return parseDef(tokens, linenum, charnum);
   }
+  else if (toktype === "deftype") {
+    return parseDefType(tokens, linenum, charnum);
+  }
   else if (toktype === "defop") {
     return parseDefOp(tokens, linenum, charnum);
   }

pprint.js

@@ -26,6 +26,10 @@ function pprintIf(ifexp) {
          " else " + pprint(ifexp.elseexp) + ")");
 }
 
+function pprintDefType(stx) {
+  return pprint(stx.lhs) + " = " + pprint(stx.rhs);
+}
+
 function pprint(expr) {
   if (expr.exprType === "Name") {
     return expr.val;
@@ -56,6 +60,9 @@ function pprint(expr) {
   else if (expr.exprType === "Definition") {
     return pprintDef(expr);
   }
+  else if (expr.exprType === "TypeDefinition") {
+    return pprintDefType(expr);
+  }
   else if (expr.exprType === "If") {
     return pprintIf(expr);
   }

representation.js

@@ -291,13 +291,13 @@ function TypeApp(expression, type) {
 
 TypeApp.prototype = TypeExpression;
 
-function DefType(rhs, lhs) {
+function DefType(lhs, rhs) {
   /* Both rhs and lhs are expected
    * to be fully desugared already
    */
-  if (!isExprType(rhs) ||
+  if (!isTypeExprRec(rhs) ||
-      !isExprType(lhs)) {
+      !isTypeExpr(lhs)) {
-        throw erros.JSyntaxError(
+        throw errors.JSyntaxError(
           rhs.linenum,
           rhs.charnum,
           "Illegal type definition, both sides must be valid type expressions");
@@ -308,6 +308,34 @@ function DefType(rhs, lhs) {
   return this;
 }
 
+DefType.prototype = Expression;
+
+function checkName(exp) {
+  if (exp.exprType !== "Name") {
+    throw errors.JSyntaxError(
+      exp.linenum,
+      exp.charnum,
+      "Expected a type variable (an identifier starting with a lowercase character), got " + exp.val);
+  }
+}
+
+function DataType(params, type) {
+  /* Params is a list of type variables
+   * type is a type expression
+   */
+  _.each(params, checkName);
+  if (!isTypeExprRec(type)) {
+    throw errors.JSyntaxError(
+      type.linenum,
+      type.charnum,
+      "Body of a type definition must be a valid type expression");
+  }
+  this.params = params;
+  this.type = type;
+  this.exprType = "TypeFuncDefinition";
+  return this;
+}
+
 
 //Applies the function ``name'' to the list of parameters
 function makeApp(name, parameters) {
@@ -381,5 +409,6 @@ module.exports =
      TypeOp : TypeOp,
      TypeApp: TypeApp,
      Closure : Closure,
-     isTypeExpr : isTypeExprRec
+     isTypeExpr : isTypeExprRec,
+     DefType : DefType
    };