From cd357e03f5abcebaea46b0a42831e7114ba3b96a Mon Sep 17 00:00:00 2001
From: Sam Vervaeck <samvv@pm.me>
Date: Fri, 16 Sep 2022 12:43:06 +0200
Subject: [PATCH] Add support for tuples

---
 src/analysis.ts    |  8 ++++++++
 src/checker.ts     | 33 +++++++++++++++++++++++++++++++--
 src/cst.ts         | 24 ++++++++++++++++++++++++
 src/diagnostics.ts |  2 +-
 src/parser.ts      | 29 ++++++++++++++++++++++++++---
 5 files changed, 90 insertions(+), 6 deletions(-)

diff --git a/src/analysis.ts b/src/analysis.ts
index 088e33a20..2e4f0aab7 100644
--- a/src/analysis.ts
+++ b/src/analysis.ts
@@ -59,6 +59,14 @@ export class Analyser {
           break;
         }
 
+        case SyntaxKind.TupleExpression:
+        {
+          for (const element of node.elements) {
+            visit(element, source);
+          }
+          break;
+        }
+
         case SyntaxKind.StructExpression:
         {
           for (const member of node.members) {
diff --git a/src/checker.ts b/src/checker.ts
index cd657e9e5..62cbf81c2 100644
--- a/src/checker.ts
+++ b/src/checker.ts
@@ -841,6 +841,14 @@ export class Checker {
   private inferKindFromTypeExpression(node: TypeExpression, env: KindEnv): Kind {
     let kind: Kind;
     switch (node.kind) {
+      case SyntaxKind.TupleTypeExpression:
+      {
+        for (const element of node.elements) {
+          this.unifyKind(this.inferKindFromTypeExpression(element, env), new KStar(), node);
+        }
+        kind = new KStar();
+        break;
+      }
       case SyntaxKind.ArrowTypeExpression:
       {
         for (const param of node.paramTypeExprs) {
@@ -1250,6 +1258,9 @@ export class Checker {
         return resultType;
       }
 
+      case SyntaxKind.TupleExpression:
+        return new TTuple(node.elements.map(el => this.inferExpression(el)), node);
+
       case SyntaxKind.ReferenceExpression:
       {
         assert(node.modulePath.length === 0);
@@ -1407,6 +1418,12 @@ export class Checker {
           break;
         }
 
+        case SyntaxKind.TupleTypeExpression:
+        {
+          type = new TTuple(node.elements.map(el => this.inferTypeExpression(el)), node);
+          break;
+        }
+
         case SyntaxKind.NestedTypeExpression:
           return this.inferTypeExpression(node.typeExpr, introduceTypeVars);
 
@@ -1969,8 +1986,20 @@ export class Checker {
               return success;
             }
 
-            if (right.kind === TypeKind.Arrow) {
-              return unify(right, left);
+            if (left.kind === TypeKind.Tuple && right.kind === TypeKind.Tuple) {
+              if (left.elementTypes.length === right.elementTypes.length) {
+                let success = false;
+                const count = left.elementTypes.length;
+                for (let i = 0; i < count; i++) {
+                  if (!unify(left.elementTypes[i], right.elementTypes[i])) {
+                    success = false;
+                  }
+                }
+                if (success) {
+                  TypeBase.join(left, right);
+                }
+                return success;
+              }
             }
 
             if (left.kind === TypeKind.Con && right.kind === TypeKind.Con) {
diff --git a/src/cst.ts b/src/cst.ts
index 6681c8fb3..eb3bf3403 100644
--- a/src/cst.ts
+++ b/src/cst.ts
@@ -112,6 +112,7 @@ export const enum SyntaxKind {
   VarTypeExpression,
   AppTypeExpression,
   NestedTypeExpression,
+  TupleTypeExpression,
 
   // Patterns
   BindPattern,
@@ -1007,6 +1008,28 @@ export class ArrowTypeExpression extends SyntaxBase {
 
 }
 
+export class TupleTypeExpression extends SyntaxBase {
+
+  public readonly kind = SyntaxKind.TupleTypeExpression;
+
+  public constructor(
+    public lparen: LParen,
+    public elements: TypeExpression[],
+    public rparen: RParen,
+  ) {
+    super();
+  }
+
+  public getFirstToken(): Token {
+    return this.lparen;
+  }
+
+  public getLastToken(): Token {
+    return this.rparen;
+  }
+
+}
+
 export class ReferenceTypeExpression extends SyntaxBase {
 
   public readonly kind = SyntaxKind.ReferenceTypeExpression;
@@ -1103,6 +1126,7 @@ export type TypeExpression
   | VarTypeExpression
   | AppTypeExpression
   | NestedTypeExpression
+  | TupleTypeExpression
 
 export class BindPattern extends SyntaxBase {
 
diff --git a/src/diagnostics.ts b/src/diagnostics.ts
index 303e1436b..faaad0643 100644
--- a/src/diagnostics.ts
+++ b/src/diagnostics.ts
@@ -190,7 +190,7 @@ export function describeType(type: Type): string {
         else out += ', ';
         out += describeType(elementType);
       }
-      return out;
+      return out + ')';
     }
     case TypeKind.Nominal:
     {
diff --git a/src/parser.ts b/src/parser.ts
index 9b822611e..91a08afd1 100644
--- a/src/parser.ts
+++ b/src/parser.ts
@@ -58,6 +58,7 @@ import {
   MatchExpression,
   LiteralPattern,
   DisjunctivePattern,
+  TupleTypeExpression,
 } from "./cst"
 import { Stream } from "./util";
 
@@ -185,9 +186,30 @@ export class Parser {
       case SyntaxKind.LParen:
       {
         this.getToken();
-        const typeExpr = this.parseTypeExpression();
-        const t2 = this.expectToken(SyntaxKind.RParen);
-        return new NestedTypeExpression(t0, typeExpr, t2);
+        const elements = [];
+        let rparen;
+        for (;;) {
+          const t2 = this.peekToken();
+          if (t2.kind === SyntaxKind.RParen) {
+            rparen = t2;
+            break;
+          }
+          const typeExpr = this.parseTypeExpression();
+          elements.push(typeExpr);
+          const t3 = this.getToken();
+          if (t3.kind === SyntaxKind.RParen) {
+            rparen = t3;
+            break;
+          } else if (t3.kind === SyntaxKind.Comma) {
+            continue;
+          } else {
+            this.raiseParseError(t3, [ SyntaxKind.Comma, SyntaxKind.RParen ]);
+          }
+        }
+        if (elements.length === 1) {
+          return new NestedTypeExpression(t0, elements[0], rparen);
+        }
+        return new TupleTypeExpression(t0, elements, rparen);
       }
       case SyntaxKind.IdentifierAlt:
         return this.parseReferenceTypeExpression();
@@ -204,6 +226,7 @@ export class Parser {
       if (t1.kind === SyntaxKind.RParen
           || t1.kind === SyntaxKind.RBrace
           || t1.kind === SyntaxKind.RBracket
+          || t1.kind === SyntaxKind.Comma
           || t1.kind === SyntaxKind.Equals
           || t1.kind === SyntaxKind.BlockStart
           || t1.kind === SyntaxKind.LineFoldEnd