From 82e839bccb0f4054fd622aa765a761804518b6f0 Mon Sep 17 00:00:00 2001
From: Paulo Matos
Date: Wed, 1 Jul 2026 19:11:45 +0200
Subject: [PATCH] Interpret case-lambda (#3)
Add a CaseLambda AST node and CaseLambdaClosure runtime value that dispatch an application to the first clause whose formals accept the supplied argument count, reusing the existing lambda formal-binding and free-variable capture machinery.
---
src/AST.cpp | 24 +++++
src/ASTRuntime.cpp | 41 +++++++-
src/AnalysisFreeVars.cpp | 13 +++
src/Interpreter.cpp | 165 ++++++++++++++++++++----------
src/Parse.cpp | 66 +++++++++++-
src/include/AST.h | 29 ++++++
src/include/ASTRuntime.h | 21 ++++
src/include/ASTVisitor.h | 2 +
src/include/AST_fwd.h | 2 +
src/include/AnalysisFreeVars.h | 2 +
src/include/Interpreter.h | 9 ++
src/include/Parse.h | 1 +
test/integration/case-lambda.rkt | 3 +
test/integration/case-lambda1.rkt | 4 +
test/integration/case-lambda2.rkt | 4 +
test/integration/case-lambda3.rkt | 5 +
test/integration/case-lambda4.rkt | 8 ++
test/unit/test_parse.cpp | 22 ++++
18 files changed, 363 insertions(+), 58 deletions(-)
create mode 100644 test/integration/case-lambda.rkt
create mode 100644 test/integration/case-lambda1.rkt
create mode 100644 test/integration/case-lambda2.rkt
create mode 100644 test/integration/case-lambda3.rkt
create mode 100644 test/integration/case-lambda4.rkt
diff --git a/src/AST.cpp b/src/AST.cpp
index 254dc7f..5909879 100644
--- a/src/AST.cpp
+++ b/src/AST.cpp
@@ -237,6 +237,30 @@ void Lambda::dump() const {
void Lambda::write() const { std::cout << "#"; }
+//
+// Implementation of CaseLambda node.
+//
+
+CaseLambda::CaseLambda(CaseLambda const &CL)
+ : ClonableNode(ASTNodeKind::AST_CaseLambda) {
+ Clauses.reserve(CL.Clauses.size());
+ for (auto const &C : CL.Clauses) {
+ Clauses.push_back(
+ std::unique_ptr(static_cast(C->clone())));
+ }
+}
+
+void CaseLambda::dump() const {
+ llvm::dbgs() << "(case-lambda";
+ for (auto const &C : Clauses) {
+ llvm::dbgs() << " ";
+ C->dump();
+ }
+ llvm::dbgs() << ")";
+}
+
+void CaseLambda::write() const { std::cout << "#"; }
+
//
// Implementation of DefineValues node.
//
diff --git a/src/ASTRuntime.cpp b/src/ASTRuntime.cpp
index 67f75fd..73a42e0 100644
--- a/src/ASTRuntime.cpp
+++ b/src/ASTRuntime.cpp
@@ -42,4 +42,43 @@ void Closure::dump() const {
// TODO: Implement.
llvm::dbgs() << "\n";
}
-void Closure::write() const {}
\ No newline at end of file
+void Closure::write() const {}
+
+CaseLambdaClosure::CaseLambdaClosure(const CaseLambda &CLbd,
+ const std::vector &Envs)
+ : ClonableNode(ASTNodeKind::AST_CaseLambdaClosure),
+ CL(std::unique_ptr(static_cast(CLbd.clone()))) {
+
+ // Capture the free variables across all clauses, mirroring Closure.
+
+ // 1. Find the free variables in the case-lambda.
+ AnalysisFreeVars AFV;
+ CL->accept(AFV);
+ auto const &FreeVars = AFV.getResult();
+
+ // 2. Find in the current environment, the values of the free variables
+ // and save them.
+ for (auto const &Var : FreeVars) {
+ for (auto const &E : llvm::reverse(Envs)) {
+ auto const &Val = E.lookup(Var);
+ if (Val) {
+ Env.add(Var, std::unique_ptr(Val->clone()));
+ break;
+ }
+ }
+ }
+}
+
+CaseLambdaClosure::CaseLambdaClosure(const CaseLambdaClosure &Other)
+ : ClonableNode(ASTNodeKind::AST_CaseLambdaClosure),
+ CL(std::unique_ptr(
+ static_cast(Other.CL->clone()))) {
+ for (auto const &E : Other.Env) {
+ Env.add(E.first, std::unique_ptr(E.second->clone()));
+ }
+}
+
+void CaseLambdaClosure::dump() const {
+ llvm::dbgs() << "\n";
+}
+void CaseLambdaClosure::write() const {}
\ No newline at end of file
diff --git a/src/AnalysisFreeVars.cpp b/src/AnalysisFreeVars.cpp
index 9d58e19..5fd1a43 100644
--- a/src/AnalysisFreeVars.cpp
+++ b/src/AnalysisFreeVars.cpp
@@ -66,11 +66,24 @@ void AnalysisFreeVars::visit(ast::Lambda const &L) {
Vars.pop_back();
}
+void AnalysisFreeVars::visit(ast::CaseLambda const &CL) {
+ // A case-lambda's free variables are the union over all its clauses. Each
+ // clause is a Lambda that binds its own formals around its own body.
+ for (size_t Idx = 0; Idx < CL.size(); ++Idx) {
+ CL[Idx].accept(*this);
+ }
+}
+
void AnalysisFreeVars::visit(ast::Closure const &L) {
// Closures by definition do not have free variables.
// Nothing to do.
}
+void AnalysisFreeVars::visit(ast::CaseLambdaClosure const &CL) {
+ // Case-lambda closures by definition do not have free variables.
+ // Nothing to do.
+}
+
void AnalysisFreeVars::visit(ast::Begin const &B) {
// Iterate through all the begin expressions and check for free variables.
for (auto const &Expr : B.getBody()) {
diff --git a/src/Interpreter.cpp b/src/Interpreter.cpp
index 7eeabb4..919bac8 100644
--- a/src/Interpreter.cpp
+++ b/src/Interpreter.cpp
@@ -180,6 +180,18 @@ void Interpreter::visit(ast::Closure const &C) {
Result = std::unique_ptr(C.clone());
}
+void Interpreter::visit(ast::CaseLambda const &CL) {
+ // The interpretation of a case-lambda expression is a closure,
+ // even if no variables are captured.
+ LLVM_DEBUG(llvm::dbgs() << "Interpreting CaseLambda\n");
+ Result = std::make_unique(CL, Envs);
+}
+
+void Interpreter::visit(ast::CaseLambdaClosure const &C) {
+ LLVM_DEBUG(llvm::dbgs() << "Interpreting CaseLambdaClosure\n");
+ Result = std::unique_ptr(C.clone());
+}
+
void Interpreter::visit(ast::Begin const &B) {
LLVM_DEBUG(llvm::dbgs() << "Interpreting Begin\n");
@@ -215,15 +227,76 @@ void Interpreter::visit(ast::Vector const &Vec) {
Result = std::unique_ptr(Vec.clone());
}
+// Returns true if the formals F accept NArgs supplied arguments.
+static bool formalsAccept(const ast::Formal &F, size_t NArgs) {
+ switch (F.getType()) {
+ case ast::Formal::Type::List:
+ return static_cast(F).size() == NArgs;
+ case ast::Formal::Type::ListRest:
+ return static_cast(F).size() <= NArgs;
+ case ast::Formal::Type::Identifier:
+ return true;
+ }
+ llvm_unreachable("unknown formal type");
+}
+
+void Interpreter::applyFormals(
+ const ast::Formal &F, const ast::ExprNode &Body,
+ const Environment &CapturedEnv,
+ std::vector> &Args) {
+ // Create an environment where each argument is bound to the corresponding
+ // value. Then evaluate the body in this environment.
+ Environment Env;
+ if (F.getType() == ast::Formal::Type::List) {
+ auto LF = static_cast(F);
+ for (size_t Idx = 0; Idx < Args.size(); ++Idx) {
+ Env.add(LF[Idx], std::move(Args[Idx]));
+ }
+ } else if (F.getType() == ast::Formal::Type::ListRest) {
+ auto LRF = static_cast(F);
+ size_t Idx = 0;
+ for (; Idx < LRF.size(); ++Idx) {
+ Env.add(LRF[Idx], std::move(Args[Idx]));
+ }
+ // Create a list of the remaining arguments.
+ auto L = std::make_unique();
+ for (; Idx < Args.size(); ++Idx) {
+ L->appendExpr(std::move(Args[Idx]));
+ }
+ Env.add(LRF.getRestFormal(), std::unique_ptr(L->clone()));
+ } else if (F.getType() == ast::Formal::Type::Identifier) {
+ auto IF = static_cast(F);
+ auto L = std::make_unique();
+ for (size_t Idx = 0; Idx < Args.size(); ++Idx) {
+ L->appendExpr(std::move(Args[Idx]));
+ }
+ Env.add(IF.getIdentifier(), std::unique_ptr(L->clone()));
+ } else {
+ llvm_unreachable("unknown formal type");
+ }
+
+ Envs.push_back(CapturedEnv); // Pushes the closure environment first.
+ Envs.push_back(Env); // Then pushes the environment with the args.
+
+ Body.accept(*this);
+
+ Envs.pop_back();
+ Envs.pop_back();
+}
+
void Interpreter::visit(ast::Application const &A) {
// 1. Evaluate the first expression.
// which should evaluate to a lambda expression.
A[0].accept(*this);
std::unique_ptr D = std::move(Result);
- // Error out if not a Closure expression or Runtime expression.
+ // Error out if not a Closure, CaseLambdaClosure, or Runtime function.
std::unique_ptr C = dyn_castU(D);
+ std::unique_ptr CLC;
if (!C) {
+ CLC = dyn_castU(D);
+ }
+ if (!C && !CLC) {
// maybe a runtime function?
std::unique_ptr RF =
dyn_castU(D);
@@ -276,70 +349,50 @@ void Interpreter::visit(ast::Application const &A) {
assert(Result && "Expected result from expression.");
Args.emplace_back(std::move(Result));
}
+ // 3. Single-clause closure: check arity and apply.
// If we have a list formals then, error out of args diff than formals.
// If we have a list rest formals then, error out if args less than formals.
// If it's identifier formals then it does not matter.
- const ast::Lambda &L = C->getLambda();
- const ast::Formal &F = L.getFormals();
- if (F.getType() == ast::Formal::Type::List) {
- auto LF = static_cast(F);
- if (Args.size() != LF.size()) {
- std::cerr << "Expected " << LF.size() << " arguments, got " << Args.size()
- << std::endl;
- Result = nullptr;
- return;
- }
- } else if (F.getType() == ast::Formal::Type::ListRest) {
- auto LRF = static_cast(F);
- if (Args.size() < LRF.size()) {
- std::cerr << "Expected at least " << LRF.size() << " arguments, got "
- << Args.size() << std::endl;
- Result = nullptr;
- return;
+ if (C) {
+ const ast::Lambda &L = C->getLambda();
+ const ast::Formal &F = L.getFormals();
+ if (F.getType() == ast::Formal::Type::List) {
+ auto LF = static_cast(F);
+ if (Args.size() != LF.size()) {
+ std::cerr << "Expected " << LF.size() << " arguments, got "
+ << Args.size() << std::endl;
+ Result = nullptr;
+ return;
+ }
+ } else if (F.getType() == ast::Formal::Type::ListRest) {
+ auto LRF = static_cast(F);
+ if (Args.size() < LRF.size()) {
+ std::cerr << "Expected at least " << LRF.size() << " arguments, got "
+ << Args.size() << std::endl;
+ Result = nullptr;
+ return;
+ }
}
- }
- // 3. Apply the lambda expression to the evaluated expressions.
- // Create an environment where each argument is bound to the corresponding
- // value. Then evaluate the lambda body in this environment.
- Environment Env;
- if (F.getType() == ast::Formal::Type::List) {
- auto LF = static_cast(F);
- for (size_t Idx = 0; Idx < Args.size(); ++Idx) {
- Env.add(LF[Idx], std::move(Args[Idx]));
- }
- } else if (F.getType() == ast::Formal::Type::ListRest) {
- auto LRF = static_cast(F);
- size_t Idx = 0;
- for (; Idx < LRF.size(); ++Idx) {
- Env.add(LRF[Idx], std::move(Args[Idx]));
- }
- // Create a list of the remaining arguments.
- auto L = std::make_unique();
- for (; Idx < Args.size(); ++Idx) {
- L->appendExpr(std::move(Args[Idx]));
- }
+ applyFormals(F, L.getBody(), C->getEnvironment(), Args);
+ return;
+ }
- Env.add(LRF.getRestFormal(), std::unique_ptr(L->clone()));
- } else if (F.getType() == ast::Formal::Type::Identifier) {
- auto IF = static_cast(F);
- auto L = std::make_unique();
- for (size_t Idx = 0; Idx < Args.size(); ++Idx) {
- L->appendExpr(std::move(Args[Idx]));
+ // 4. Case-lambda closure: apply the first clause whose formals accept the
+ // number of supplied arguments.
+ const ast::CaseLambda &CL = CLC->getCaseLambda();
+ for (size_t Idx = 0; Idx < CL.size(); ++Idx) {
+ const ast::Lambda &Clause = CL[Idx];
+ if (formalsAccept(Clause.getFormals(), Args.size())) {
+ applyFormals(Clause.getFormals(), Clause.getBody(), CLC->getEnvironment(),
+ Args);
+ return;
}
- Env.add(IF.getIdentifier(), std::unique_ptr(L->clone()));
- } else {
- llvm_unreachable("unknown formal type");
}
- Envs.push_back(C->getEnvironment()); // Pushes the closure environment first.
- Envs.push_back(Env); // Then pushes the environment with the args.
-
- // 4. Return the result of the application.
- L.getBody().accept(*this);
-
- Envs.pop_back();
- Envs.pop_back();
+ std::cerr << "case-lambda: no matching clause for " << Args.size()
+ << " arguments" << std::endl;
+ Result = nullptr;
}
// To interpret a set! expression we set the value of the identifier in the
diff --git a/src/Parse.cpp b/src/Parse.cpp
index 95f2387..4acfab7 100644
--- a/src/Parse.cpp
+++ b/src/Parse.cpp
@@ -58,7 +58,7 @@ using namespace Lex;
//
// expr := - parseIdentifier
// | (lambda ) - parseLambda
-// | (case-lambda ( ) ...)
+// | (case-lambda ( ) ...) - parseCaseLambda
// | (if ) - parseIfCond
// | (begin ...+) - parseBegin
// | (begin0 ...+) - parseBegin
@@ -201,6 +201,11 @@ std::unique_ptr Parse::parseExpr(SourceStream &S) {
return L;
}
+ std::unique_ptr CL = parseCaseLambda(S);
+ if (CL) {
+ return CL;
+ }
+
std::unique_ptr B = parseBegin(S);
if (B) {
return B;
@@ -621,6 +626,65 @@ std::unique_ptr Parse::parseLambda(SourceStream &S) {
return Lambda;
}
+// Parse case-lambda expression of the form:
+// (case-lambda ( ) ...)
+std::unique_ptr Parse::parseCaseLambda(SourceStream &S) {
+ size_t Start = S.getPosition();
+
+ Tok T = gettok(S);
+ if (!T.is(Tok::TokType::LPAREN)) {
+ S.rewindTo(Start);
+ return nullptr;
+ }
+
+ T = gettok(S);
+ if (!T.is(Tok::TokType::CASE_LAMBDA)) {
+ S.rewindTo(Start);
+ return nullptr;
+ }
+
+ auto CaseLambda = std::make_unique();
+
+ // Parse zero or more clauses of the form ( ).
+ while (true) {
+ T = gettok(S);
+ if (T.is(Tok::TokType::RPAREN)) {
+ break; // End of the case-lambda.
+ }
+ if (!T.is(Tok::TokType::LPAREN)) {
+ S.rewindTo(Start);
+ return nullptr;
+ }
+
+ // Each clause reuses the lambda machinery: formals plus a single body.
+ auto Clause = std::make_unique();
+
+ std::unique_ptr Formals = parseFormals(S);
+ if (!Formals) {
+ S.rewindTo(Start);
+ return nullptr;
+ }
+ Clause->setFormals(std::move(Formals));
+
+ std::unique_ptr Body = parseExpr(S);
+ if (!Body) {
+ S.rewindTo(Start);
+ return nullptr;
+ }
+ Clause->setBody(std::move(Body));
+
+ T = gettok(S);
+ if (!T.is(Tok::TokType::RPAREN)) {
+ S.rewindTo(Start);
+ return nullptr;
+ }
+
+ CaseLambda->addClause(std::move(Clause));
+ }
+
+ return CaseLambda;
+}
+
// Parse formals of the form:
// (id ...)
// (id ... . id)
diff --git a/src/include/AST.h b/src/include/AST.h
index 7d0ecb5..08bf769 100644
--- a/src/include/AST.h
+++ b/src/include/AST.h
@@ -43,6 +43,8 @@ class ASTNode {
AST_SetBang,
First_ValueNode, // all ValueNodes must be after this
AST_BooleanLiteral,
+ AST_CaseLambda,
+ AST_CaseLambdaClosure, // result of evaluating a CaseLambda expression
AST_Char,
AST_Closure, // result of evaluating a Lambda expression
AST_Integer,
@@ -594,6 +596,33 @@ class Lambda : public ClonableNode {
std::unique_ptr Body;
};
+// A case-lambda is a sequence of lambda clauses. When applied, the first
+// clause whose formals accept the number of supplied arguments is selected.
+// Defined in terms of Lambda, so it is placed right after it.
+class CaseLambda : public ClonableNode {
+public:
+ CaseLambda() : ClonableNode(ASTNodeKind::AST_CaseLambda) {}
+ CaseLambda(CaseLambda const &CL);
+ CaseLambda(CaseLambda &&CL) = default;
+ ~CaseLambda() = default;
+
+ void addClause(std::unique_ptr C) { Clauses.push_back(std::move(C)); }
+ [[nodiscard]] size_t size() const { return Clauses.size(); }
+ [[nodiscard]] Lambda const &operator[](size_t Idx) const {
+ return *Clauses[Idx];
+ }
+
+ LLVM_DUMP_METHOD void dump() const override;
+ void write() const override;
+
+ static bool classof(const ASTNode *N) {
+ return N->getKind() == ASTNodeKind::AST_CaseLambda;
+ }
+
+private:
+ llvm::SmallVector> Clauses;
+};
+
class LetValues : public ClonableNode {
public:
LetValues() : ClonableNode(ASTNodeKind::AST_LetValues) {}
diff --git a/src/include/ASTRuntime.h b/src/include/ASTRuntime.h
index 7e4caf2..64b852f 100644
--- a/src/include/ASTRuntime.h
+++ b/src/include/ASTRuntime.h
@@ -33,4 +33,25 @@ class Closure : public ClonableNode {
Environment Env;
};
+// A CaseLambdaClosure is the runtime manifestation of a CaseLambda.
+class CaseLambdaClosure : public ClonableNode {
+public:
+ CaseLambdaClosure(const CaseLambda &CL, const std::vector &Envs);
+ CaseLambdaClosure(const CaseLambdaClosure &Other);
+
+ static bool classof(const ASTNode *N) {
+ return N->getKind() == ASTNodeKind::AST_CaseLambdaClosure;
+ }
+
+ LLVM_DUMP_METHOD void dump() const override;
+ void write() const override;
+
+ const CaseLambda &getCaseLambda() const { return *CL; }
+ const Environment &getEnvironment() const { return Env; }
+
+private:
+ std::unique_ptr CL;
+ Environment Env;
+};
+
}; // namespace ast
\ No newline at end of file
diff --git a/src/include/ASTVisitor.h b/src/include/ASTVisitor.h
index 16b2259..165ec84 100644
--- a/src/include/ASTVisitor.h
+++ b/src/include/ASTVisitor.h
@@ -11,6 +11,8 @@ class ASTVisitor {
virtual void visit(ast::Application const &A) = 0;
virtual void visit(ast::Begin const &B) = 0;
virtual void visit(ast::BooleanLiteral const &Bool) = 0;
+ virtual void visit(ast::CaseLambda const &CL) = 0;
+ virtual void visit(ast::CaseLambdaClosure const &CL) = 0;
virtual void visit(ast::Char const &C) = 0;
virtual void visit(ast::Closure const &L) = 0;
virtual void visit(ast::DefineValues const &DV) = 0;
diff --git a/src/include/AST_fwd.h b/src/include/AST_fwd.h
index ee0f054..2e3fe5e 100644
--- a/src/include/AST_fwd.h
+++ b/src/include/AST_fwd.h
@@ -5,6 +5,8 @@ namespace ast {
class Application;
class Begin;
class BooleanLiteral;
+class CaseLambda;
+class CaseLambdaClosure;
class Char;
class Closure;
class DefineValues;
diff --git a/src/include/AnalysisFreeVars.h b/src/include/AnalysisFreeVars.h
index 3a312bc..715e7eb 100644
--- a/src/include/AnalysisFreeVars.h
+++ b/src/include/AnalysisFreeVars.h
@@ -19,6 +19,8 @@ class AnalysisFreeVars : public ASTVisitor {
virtual void visit(ast::Application const &A) override;
virtual void visit(ast::Begin const &B) override;
virtual void visit(ast::BooleanLiteral const &Bool) override;
+ virtual void visit(ast::CaseLambda const &CL) override;
+ virtual void visit(ast::CaseLambdaClosure const &CL) override;
virtual void visit(ast::Char const &C) override;
virtual void visit(ast::Closure const &L) override;
virtual void visit(ast::DefineValues const &DV) override;
diff --git a/src/include/Interpreter.h b/src/include/Interpreter.h
index 98bfe60..b889d53 100644
--- a/src/include/Interpreter.h
+++ b/src/include/Interpreter.h
@@ -23,6 +23,8 @@ class Interpreter : public ASTVisitor {
virtual void visit(ast::Application const &A) override;
virtual void visit(ast::Begin const &B) override;
virtual void visit(ast::BooleanLiteral const &Bool) override;
+ virtual void visit(ast::CaseLambda const &CL) override;
+ virtual void visit(ast::CaseLambdaClosure const &CL) override;
virtual void visit(ast::Char const &C) override;
virtual void visit(ast::Closure const &L) override;
virtual void visit(ast::DefineValues const &DV) override;
@@ -57,6 +59,13 @@ class Interpreter : public ASTVisitor {
}
private:
+ // Binds Args to the formals F in a fresh environment, then evaluates Body
+ // with CapturedEnv and that environment pushed, leaving the value in Result.
+ // Precondition: F accepts Args.size() arguments.
+ void applyFormals(const ast::Formal &F, const ast::ExprNode &Body,
+ const Environment &CapturedEnv,
+ std::vector> &Args);
+
std::vector Envs; /// Environment map for identifiers.
std::unique_ptr Result; /// Result of the last evaluation.
};
diff --git a/src/include/Parse.h b/src/include/Parse.h
index 147f26b..b639e15 100644
--- a/src/include/Parse.h
+++ b/src/include/Parse.h
@@ -32,6 +32,7 @@ bool isSpecialInitial(SourceStream &S, size_t Offset = 0);
std::unique_ptr parseApplication(SourceStream &S);
std::unique_ptr parseBegin(SourceStream &S);
std::unique_ptr parseBooleanLiteral(SourceStream &S);
+std::unique_ptr parseCaseLambda(SourceStream &S);
std::unique_ptr parseChar(SourceStream &S);
std::unique_ptr parseDefineValues(SourceStream &S);
std::unique_ptr parseExpr(SourceStream &S);
diff --git a/test/integration/case-lambda.rkt b/test/integration/case-lambda.rkt
new file mode 100644
index 0000000..54c7e3e
--- /dev/null
+++ b/test/integration/case-lambda.rkt
@@ -0,0 +1,3 @@
+;; RUN: norac %s | FileCheck %s
+;; CHECK: 2
+(linklet () () ((case-lambda ((x) x) ((x y) (+ x y))) 2))
diff --git a/test/integration/case-lambda1.rkt b/test/integration/case-lambda1.rkt
new file mode 100644
index 0000000..0481778
--- /dev/null
+++ b/test/integration/case-lambda1.rkt
@@ -0,0 +1,4 @@
+;; RUN: norac %s | FileCheck %s
+;; The clause selected depends on the number of arguments.
+;; CHECK: 7
+(linklet () () ((case-lambda ((x) x) ((x y) (+ x y))) 3 4))
diff --git a/test/integration/case-lambda2.rkt b/test/integration/case-lambda2.rkt
new file mode 100644
index 0000000..6481530
--- /dev/null
+++ b/test/integration/case-lambda2.rkt
@@ -0,0 +1,4 @@
+;; RUN: norac %s | FileCheck %s
+;; A clause with a rest formal collects the extra arguments into a list.
+;; CHECK: (2 3)
+(linklet () () ((case-lambda ((x) x) ((x . y) y)) 1 2 3))
diff --git a/test/integration/case-lambda3.rkt b/test/integration/case-lambda3.rkt
new file mode 100644
index 0000000..4e6d34e
--- /dev/null
+++ b/test/integration/case-lambda3.rkt
@@ -0,0 +1,5 @@
+;; RUN: norac %s | FileCheck %s
+;; An identifier formal accepts any number of arguments as a list, so it acts
+;; as the fallthrough clause after the fixed-arity clauses.
+;; CHECK: (1 2)
+(linklet () () ((case-lambda (() 0) (args args)) 1 2))
diff --git a/test/integration/case-lambda4.rkt b/test/integration/case-lambda4.rkt
new file mode 100644
index 0000000..c94f30d
--- /dev/null
+++ b/test/integration/case-lambda4.rkt
@@ -0,0 +1,8 @@
+;; RUN: norac %s | FileCheck %s
+;; A case-lambda captures its free variables across every clause.
+;; CHECK: 15
+(linklet () ()
+ (define-values (f) (values 0))
+ (let-values (((n) (values 10)))
+ (set! f (case-lambda ((x) (+ x n)) ((x y) (+ x y n)))))
+ (f 5))
diff --git a/test/unit/test_parse.cpp b/test/unit/test_parse.cpp
index 2629ea0..02ea541 100644
--- a/test/unit/test_parse.cpp
+++ b/test/unit/test_parse.cpp
@@ -294,6 +294,28 @@ TEST_CASE("Parsing lambdas", "[parser]") {
REQUIRE(Var.getName() == "x");
}
+TEST_CASE("Parsing case-lambda", "[parser]") {
+ SourceStream CL1("(case-lambda ((x) x) ((x y) (+ x y)))");
+ std::unique_ptr CL = parseCaseLambda(CL1);
+ REQUIRE(CL);
+ REQUIRE(CL->size() == 2);
+ REQUIRE((*CL)[0].getFormalsType() == ast::Formal::Type::List);
+ REQUIRE((*CL)[1].getFormalsType() == ast::Formal::Type::List);
+
+ // A clause may use a rest formal.
+ SourceStream CL2("(case-lambda ((x) x) ((x . y) y))");
+ CL = parseCaseLambda(CL2);
+ REQUIRE(CL);
+ REQUIRE(CL->size() == 2);
+ REQUIRE((*CL)[1].getFormalsType() == ast::Formal::Type::ListRest);
+
+ // A case-lambda with no clauses is valid.
+ SourceStream CL3("(case-lambda)");
+ CL = parseCaseLambda(CL3);
+ REQUIRE(CL);
+ REQUIRE(CL->size() == 0);
+}
+
TEST_CASE("Parsing begin", "[parser]") {
SourceStream B1("(begin 1 2 3)");
std::unique_ptr B = parseBegin(B1);