diff --git a/Expr.g.cs b/Expr.g.cs index ffd5a41..963fd75 100644 --- a/Expr.g.cs +++ b/Expr.g.cs @@ -125,7 +125,7 @@ public partial record Let(Binding[] Bindings, Expr Body) : Expr() return visitor.visitLetExpr(context, this); } } -public partial record When(Expr Head, Binding[] Cases) : Expr() +public partial record When(Expr Head, VarBinding[] Cases) : Expr() { public override TResult accept(TContext context, IExprVisitor visitor) { diff --git a/Interpreter.cs b/Interpreter.cs index fd90310..d912686 100644 --- a/Interpreter.cs +++ b/Interpreter.cs @@ -595,6 +595,26 @@ public class Interpreter : AST.IExprVisitor public object visitWhenExpr(Env env, AST.When expr) { - throw new System.NotImplementedException(); + var head = evaluate(env, expr.Head); + // TODO use real info + var tok = new Token(TokenType.When, "when", null, 1); + foreach (var c in expr.Cases) + { + try + { + var newEnv = new Env(env); + c.Pattern.accept((head, newEnv), new PatternBinder()); + return evaluate(newEnv, c.Value); + } + catch (PatternTagMismatchException) + { + continue; + } + catch (PatternTypeMismatchException e) + { + throw new RuntimeError(tok, e.Message); + } + } + throw new RuntimeError(tok, "No matching patterns."); } } \ No newline at end of file diff --git a/Parser.cs b/Parser.cs index 6ab195a..0b75ffc 100644 --- a/Parser.cs +++ b/Parser.cs @@ -308,7 +308,7 @@ class Parser Expr head = expression(); consume(TokenType.Is, "Expect 'is' after expression."); - List cases = new List(); + List cases = new List(); cases.Add(parseCase()); while (match(TokenType.Comma)) { @@ -316,7 +316,7 @@ class Parser } return new When(head, cases.ToArray()); - Binding parseCase() + VarBinding parseCase() { Pattern pat = pattern(); consume(TokenType.DoubleArrow, "Expect '=>' after pattern."); diff --git a/ast_classes.fsx b/ast_classes.fsx index 170afb3..d6c7c19 100644 --- a/ast_classes.fsx +++ b/ast_classes.fsx @@ -45,7 +45,7 @@ let exprTypes = Name = "Bindings" } { Type = "Expr"; Name = "Body" } ] } { Name = "When" - Fields = [ { Type = "Expr"; Name = "Head" }; { Type = "Binding[]"; Name = "Cases" } ] } ] + Fields = [ { Type = "Expr"; Name = "Head" }; { Type = "VarBinding[]"; Name = "Cases" } ] } ] let patternTypes = [ { Name = "SimplePattern"