Exhaustiveness checking

src/typechecker.ts

@@ -221,8 +221,12 @@ function infer(expr: AST, env: TypeEnv, subst: Subst): TypeAST | null {
             const scrutType = infer(expr.expr, env, subst);
             if (expr.cases.length === 0) return null;
             const firstEnv = new Map(env);
-            if (scrutType) bindPattern(expr.cases[0].pattern, scrutType, firstEnv, subst);
+            if (scrutType) {
+                bindPattern(expr.cases[0].pattern, scrutType, firstEnv, subst);
+                checkExhaustiveness(scrutType, expr.cases, expr.expr, subst);
+            }
             return infer(expr.cases[0].result, firstEnv, subst);
+
         }
 
         default:
@@ -263,6 +267,9 @@ function check(expr: AST, expected: TypeAST, env: TypeEnv, subst: Subst): string
             const err = check(c.result, expected, caseEnv, subst);
             if (err) warn(err, c.result);
         }
+        if (scrutType) {
+            checkExhaustiveness(scrutType, expr.cases, expr.expr, subst);
+        }
         return null;
     }
 
@@ -365,6 +372,7 @@ function bindPattern(pattern: Pattern, type: TypeAST, env: TypeEnv, subst: Subst
 let moduleConstraints = new Map<string, { param: string, className: string }>();
 let moduleInstances = new Map<string, Set<string>>();
 let inferredConstraints: { varName: string, className: string }[] = [];
+let typeConstructors = new Map<string, string[]>();
 
 export function typecheck(defs: Definition[], typeDefs: TypeDefinition[] = [], classDefs: ClassDefinition[] = [], instances: InstanceDeclaration[] = []) {
     const env: TypeEnv = new Map();
@@ -387,6 +395,8 @@ export function typecheck(defs: Definition[], typeDefs: TypeDefinition[] = [], c
 
     // Register constructors
     for (const td of typeDefs) {
+        typeConstructors.set(td.name, td.constructors.map(c => c.name));
+
         const resultType: TypeAST = td.params.length === 0
             ? { kind: 'type-name', name: td.name }
             : { kind: 'type-apply', constructor: { kind: 'type-name', name: td.name }, args: td.params.map(p => ({ kind: 'type-var', name: p })) };
@@ -496,3 +506,34 @@ function freshen(type: TypeAST, subst: Subst): { type: TypeAST, varMap: Map<stri
     }
     return { type: result, varMap };
 }
+
+function checkExhaustiveness(scrutType: TypeAST, cases: { pattern: Pattern }[], expr: AST, subst: Subst) {
+    const resolved = applySubst(scrutType, subst);
+
+    // Find type name
+    let typeName: string | null = null;
+    if (resolved.kind === 'type-name') typeName = resolved.name;
+    if (resolved.kind === 'type-apply' && resolved.constructor.kind === 'type-name') typeName = resolved.constructor.name;
+    if (!typeName) return;
+
+    const allCtors = typeConstructors.get(typeName);
+    if (!allCtors) return;
+
+    // Any catch-alls?
+    const hasCatchAll = cases.some(c => c.pattern.kind === 'var' || c.pattern.kind === 'wildcard');
+    if (hasCatchAll) return;
+
+    // Collect constructor names
+    const coveredCtors = new Set<string>();
+
+    for (const c of cases) {
+        if (c.pattern.kind === 'constructor') {
+            coveredCtors.add(c.pattern.name);
+        }
+    }
+
+    const missing = allCtors.filter(name => !coveredCtors.has(name));
+    if (missing.length > 0) {
+        warn(`Non-exhaustive match, missing: ${missing.join(', ')}`, expr);
+    }
+}