Parse when-expressions

Expr.g.cs

@@ -25,6 +25,7 @@ public interface IExprVisitor<T> {
 	T visitIndexerExpr(Indexer expr);
 	T visitCallExpr(Call expr);
 	T visitLetExpr(Let expr);
+	T visitWhenExpr(When expr);
 }
 public partial record Sequence(Expr Left, Expr Right) : Expr()
 {
@@ -124,3 +125,10 @@ public partial record Let(Binding[] Bindings, Expr Body) : Expr()
 		return visitor.visitLetExpr(this);
 	}
 }
+public partial record When(Expr Head, Binding[] Cases) : Expr()
+{
+	public override T accept<T>(IExprVisitor<T> visitor)
+	{
+		return visitor.visitWhenExpr(this);
+	}
+}

Parser.cs

@@ -245,9 +245,10 @@ class Parser
 	{
 		if (!match(TokenType.Let))
 		{
-			return control();
+			return ifExpr();
 		}
 
+		// TODO Add function bindings.
 		List<Binding> bindings = new List<Binding>();
 		Pattern p = pattern();
 		consume(TokenType.Equal, "Expect '=' after pattern.");
@@ -263,24 +264,64 @@ class Parser
 		return new Let(bindings.ToArray(), body);
 	}
 
-	private Expr control()
+	private Expr ifExpr()
 	{
-		switch (peek().type)
+		if (!match(TokenType.If))
 		{
-			case TokenType.If:
+			return when();
-				advance();
+		}
 		Expr condition = expression();
 		consume(TokenType.Then, "Expect 'then' after condition.");
 		Expr thenCase = expression();
 		consume(TokenType.Else, "Expect 'else' after 'then' case.");
 		Expr elseCase = expression();
 		return new If(condition, thenCase, elseCase);
-			case TokenType.When:
-				throw new NotImplementedException("TODO when");
 	}
 
+	// private Expr control()
+	// {
+	// 	switch (peek().type)
+	// 	{
+	// 		case TokenType.If:
+	// 			advance();
+	// 			Expr condition = expression();
+	// 			consume(TokenType.Then, "Expect 'then' after condition.");
+	// 			Expr thenCase = expression();
+	// 			consume(TokenType.Else, "Expect 'else' after 'then' case.");
+	// 			Expr elseCase = expression();
+	// 			return new If(condition, thenCase, elseCase);
+	// 		case TokenType.When:
+	// 			throw new NotImplementedException("TODO when");
+	// 	}
+
+	// 	return primary();
+	// }
+
+	private Expr when()
+	{
+		if (!match(TokenType.When))
+		{
 			return primary();
 		}
+		Expr head = expression();
+		consume(TokenType.Is, "Expect 'is' after expression.");
+
+		List<Binding> cases = new List<Binding>();
+		cases.Add(parseCase());
+		while (match(TokenType.Comma))
+		{
+			cases.Add(parseCase());
+		}
+		return new When(head, cases.ToArray());
+
+		Binding parseCase()
+		{
+			Pattern pat = pattern();
+			consume(TokenType.DoubleArrow, "Expect '=>' after pattern.");
+			Expr value = expression();
+			return new(pat, value);
+		}
+	}
 
 	private Name? name()
 	{

ast_classes.fsx

@@ -43,7 +43,9 @@ let exprTypes =
         Fields =
           [ { Type = "Binding[]"
               Name = "Bindings" }
-            { Type = "Expr"; Name = "Body" } ] } ]
+            { Type = "Expr"; Name = "Body" } ] }
+      { Name = "When"
+        Fields = [ { Type = "Expr"; Name = "Head" }; { Type = "Binding[]"; Name = "Cases" } ] } ]
 
 let patternTypes =
     [ { Name = "SimplePattern"

grammar.txt

@@ -4,7 +4,8 @@ expression ->
 	| unary
 	| binary
 	| let
-	| control
+	| if
+	| when
 	| primary
 
 grouping -> "(" expression ")" ;
@@ -19,11 +20,8 @@ record_pattern -> "{" ( identifier ( "=" pattern )? ( "," identifier ( "=" patte
 variant_pattern -> "`" identifier ( "(" ( "_" | compound_pattern | identifier ) ")" )? ;
 parameters -> "(" ( identifier ( "," identifier )* )?")"
 let -> "let" ( identifier parameters? | pattern ) "=" expression ( "and" ( identifier parameters? | pattern ) "=" expression )* "in" expression ;
-control ->
-	| if
-	| when
 if -> "if" expression "then" expression "else" expression ;
-when -> "when" expression "is" ( ( identifier | pattern ) "=>" expression )+ ;
+when -> "when" expression "is" ( identifier | pattern ) "=>" expression ( "," ( identifier | pattern ) "=>" expression )* ;
 variant -> "`" identifier ( "(" expression ")" )? ;
 base_record -> expression ( "with" identifier "=" expression ( "," identifier "=" expression )* ","? )?
 record ->