Case optimizaton for value bindings

Author: lazear

crates/sml-core/src/elaborate.rs

@@ -9,7 +9,7 @@ use crate::{
 };
 use sml_frontend::ast;
 use sml_frontend::parser::precedence::{self, Fixity, Precedence, Query};
-use sml_util::diagnostics::Diagnostic;
+use sml_util::diagnostics::{Diagnostic, Level};
 use sml_util::interner::{Interner, Symbol};
 use sml_util::pretty_print::PrettyPrinter;
 use sml_util::span::Span;
@@ -201,7 +201,7 @@ impl<'a> Context<'a> {
     }
 
     #[inline]
-    fn scope_depth(&self) -> usize {
+    pub fn scope_depth(&self) -> usize {
         self.namespaces[self.current].depth
     }
 
@@ -370,6 +370,7 @@ pub struct ElabError {
     sp: Span,
     message: String,
     kind: ErrorKind,
+    level: Level,
 }
 
 pub enum ErrorKind {
@@ -389,6 +390,7 @@ impl ElabError {
             sp,
             message: msg.into(),
             kind: ErrorKind::Message,
+            level: Level::Error,
         }
     }
 
@@ -397,6 +399,11 @@ impl ElabError {
         self
     }
 
+    pub fn level(mut self, level: Level) -> Self {
+        self.level = level;
+        self
+    }
+
     fn convert_err(self, pp: &mut PrettyPrinter<'_>) -> Option<Diagnostic> {
         let mut buffer = String::new();
         match self.kind {
@@ -428,7 +435,11 @@ impl ElabError {
                 buffer = self.message;
             }
         }
-        Some(Diagnostic::error(self.sp, buffer))
+        match self.level {
+            Level::Warn => Some(Diagnostic::warn(self.sp, buffer)),
+            Level::Error => Some(Diagnostic::error(self.sp, buffer)),
+            Level::Bug => Some(Diagnostic::bug(self.sp, buffer)),
+        }
     }
 }
 
@@ -1705,18 +1716,28 @@ impl<'a> Context<'a> {
             });
 
             let dontgeneralize = !expr.non_expansive() || pat.flexible();
-            for (var, tv) in bindings {
+            for (var, tv) in &bindings {
                 let sch = match dontgeneralize {
                     false => ctx.generalize(tv),
                     true => {
                         // ctx.elab_errors.push(ElabError::new(pat.span, "type variables not generalized!").kind(ErrorKind::Generalize));
                         Scheme::Mono(tv)
                     }
                 };
-                ctx.define_value(var, pat.span, sch, IdStatus::Var);
+                ctx.define_value(*var, pat.span, sch, IdStatus::Var);
             }
 
-            elab.push(Decl::Val(Rule { pat, expr }));
+            match pat.kind {
+                PatKind::Var(_) | PatKind::Wild => {
+                    elab.push(Decl::Val(Rule { pat, expr }));
+                }
+                _ => {
+                    // If we have some kind of compound binding, go ahead and
+                    // do a source->source rewrite
+                    let rule = crate::match_compile::val(ctx, expr, pat, &bindings);
+                    elab.push(Decl::Val(rule));
+                }
+            }
         })
     }
 

crates/sml-core/src/match_compile.rs

@@ -17,6 +17,7 @@ use crate::builtin::constructors::{C_BIND, C_MATCH};
 use crate::elaborate::{Context, ElabError, ErrorKind};
 use crate::types::{Constructor, Type};
 use crate::{Decl, Expr, ExprKind, Lambda, Pat, PatKind, Row, Rule, SortedRecord};
+use sml_util::diagnostics::Level;
 use sml_util::interner::Symbol;
 use sml_util::span::Span;
 use sml_util::Const;
@@ -117,12 +118,7 @@ pub fn val<'a>(
     let test = ctx.fresh_var();
 
     let (ret_ty, rpat, rexpr) = match bindings.len() {
-        0 => {
-            return Rule {
-                pat,
-                expr: scrutinee,
-            }
-        }
+        0 => (pat.ty, pat, scrutinee),
         1 => {
             let (sym, ty) = bindings[0];
             let p = Pat::new(ctx.arena.pats.alloc(PatKind::Var(sym)), ty, Span::dummy());
@@ -134,6 +130,8 @@ pub fn val<'a>(
             (ty, p, e)
         }
         _ => {
+            // This is incredibly ugly, maybe clean it up at cost of performance?
+
             let mut vt = Vec::new();
             let mut vp = Vec::new();
             let mut ve = Vec::new();
@@ -176,8 +174,6 @@ pub fn val<'a>(
         }
     };
 
-    // let expr = crate::match_compile::case(ctx, expr, rw_ty, vec![Rule { pat, expr: rw_expr}], pat.span + expr.span);
-
     let pats = vec![vec![pat]];
     let mut diags = MatchDiags::with_capacity(span, 1, C_BIND);
     let (mut decls, rules) = preflight(ctx, vec![Rule { pat, expr: rexpr }], &mut diags);
@@ -367,10 +363,25 @@ impl MatchDiags {
             }
         }
         if self.inexhaustive {
-            ctx.elab_errors.push(
-                ElabError::new(self.span, "inexhaustive `case` expression")
-                    .kind(ErrorKind::Redundant),
-            );
+            match self.constr {
+                C_BIND => {
+                    let level = match ctx.scope_depth() {
+                        0 => Level::Warn,
+                        _ => Level::Error,
+                    };
+                    ctx.elab_errors.push(
+                        ElabError::new(self.span, "inexhaustive `val` binding")
+                            .kind(ErrorKind::Inexhaustive)
+                            .level(level),
+                    );
+                }
+                _ => {
+                    ctx.elab_errors.push(
+                        ElabError::new(self.span, "inexhaustive `case` expression")
+                            .kind(ErrorKind::Inexhaustive),
+                    );
+                }
+            }
         }
     }
 }
@@ -609,7 +620,7 @@ impl<'a, 'ctx> Matrix<'a, 'ctx> {
         set.sort_by(|a, b| a.cmp(&b));
 
         let mut rules = Vec::new();
-        for con in set {
+        for &con in &set {
             // Clone facts so we don't polute other branches with identical bound
             let mut f = facts.clone();
             let expr = self.specialize_const(&mut f, diags, con);
@@ -622,9 +633,13 @@ impl<'a, 'ctx> Matrix<'a, 'ctx> {
             rules.push(Rule { pat, expr });
         }
 
-        let pat = self.mk_wild(self.pats[0][0].ty);
-        let expr = self.default_matrix(facts, diags);
-        rules.push(Rule { pat, expr });
+        if set.len() == 1 && set[0] == &Const::Unit {
+            // Unit is exhaustive
+        } else {
+            let pat = self.mk_wild(self.pats[0][0].ty);
+            let expr = self.default_matrix(facts, diags);
+            rules.push(Rule { pat, expr });
+        }
 
         Expr::new(
             self.ctx.arena.exprs.alloc(ExprKind::Case(
@@ -658,7 +673,7 @@ impl<'a, 'ctx> Matrix<'a, 'ctx> {
                 self.ctx
                     .arena
                     .exprs
-                    .alloc(ExprKind::Con(crate::builtin::constructors::C_MATCH, vec![])),
+                    .alloc(ExprKind::Con(diags.constr, vec![])),
                 self.ret_ty,
                 Span::zero(),
             );

tests/match_compile/val_bind.sml

@@ -0,0 +1,35 @@
+(* give warning on top-level non-exhaustive value binding
+
+-- args: --vv
+-- expected stdout:
+-- val (x, y): int * int list = 
+--   let
+--     val c: int * int list -> int * int list = fn b => 
+--       let
+--         val (x, y): int * int list = b
+--       in 
+--         (x, y)
+--       end
+--     val a: int list = [1, 2, 3]
+--   in 
+--     
+--       case a
+--         of :: d => 
+--           let
+--             val (e, f): int * int list = d
+--           in 
+--             c (e, f)
+--           end
+--          | _ => raise Bind
+--   end
+-- 1 warnings, 0 errors
+
+-- expected stderr:
+-- Warn
+-- 34 | 
+-- 35 | val x::y = [1,2,3]
+--           ^~~~~~~~~~~~~^ inexhaustive `val` binding
+
+*)
+
+val x::y = [1,2,3]

tests/match_compile/val_bind2.sml

@@ -0,0 +1,9 @@
+(* check that elaboration of variable patterns does not become complicated
+
+-- args: --vv
+-- expected stdout:
+-- val x: int = 1
+
+*)
+
+val x = 1

tests/typecheck/flex_pass.sml

@@ -3,7 +3,7 @@
 -- args: --v
 -- expected stdout:
 -- val record: {x: int, y: bool, c: string, d: int ref}
--- val {x= x, y= y}: {x: int, y: bool, c: string, d: int ref}
+-- val (x, y): int * bool
 
 *)