From ccf66ab07cf88eefbbaa796f6827fb60e81f50f5 Mon Sep 17 00:00:00 2001
From: Folkert <folkert@folkertdev.nl>
Date: Sun, 5 Jan 2020 01:04:32 +0100
Subject: [PATCH] implement record update constraining

---
 src/can/expr.rs       | 17 ++++++++++++
 src/constrain/expr.rs | 62 +++++++++++++++++++++++++++++++++++++++++++
 src/types.rs          |  2 ++
 src/uniqueness/mod.rs |  2 ++
 4 files changed, 83 insertions(+)

diff --git a/src/can/expr.rs b/src/can/expr.rs
index ebb82603c1..921a4bc237 100644
--- a/src/can/expr.rs
+++ b/src/can/expr.rs
@@ -94,6 +94,15 @@ pub enum Expr {
         field: Lowercase,
     },
 
+    Update {
+        record_var: Variable,
+        ext_var: Variable,
+        // TODO allow qualified names here
+        symbol: Symbol,
+        name: Lowercase,
+        updates: SendMap<Lowercase, FieldUpdate>,
+    },
+
     // Sum Types
     Tag(Box<str>, Vec<Expr>),
 
@@ -101,6 +110,14 @@ pub enum Expr {
     RuntimeError(RuntimeError),
 }
 
+#[derive(Clone, Debug, PartialEq)]
+pub struct FieldUpdate {
+    pub var: Variable,
+    // I assume this is the region of the full `foo = f bar`, rather than just the rhs
+    pub region: Region,
+    pub loc_expr: Box<Located<Expr>>,
+}
+
 #[derive(Clone, Debug, PartialEq)]
 pub enum Recursive {
     Recursive,
diff --git a/src/constrain/expr.rs b/src/constrain/expr.rs
index ad7493a729..aa7ad5445a 100644
--- a/src/constrain/expr.rs
+++ b/src/constrain/expr.rs
@@ -1,6 +1,7 @@
 use crate::can::def::Declaration;
 use crate::can::def::Def;
 use crate::can::expr::Expr::{self, *};
+use crate::can::expr::FieldUpdate;
 use crate::can::ident::Lowercase;
 use crate::can::pattern::Pattern;
 use crate::can::symbol::Symbol;
@@ -103,6 +104,51 @@ pub fn constrain_expr(
                 exists(field_vars, And(constraints))
             }
         }
+        Update {
+            record_var,
+            ext_var,
+            name,
+            symbol,
+            updates,
+        } => {
+            let mut fields: SendMap<Lowercase, Type> = SendMap::default();
+            let mut vars = Vec::with_capacity(updates.len() + 2);
+            let mut cons = Vec::with_capacity(updates.len() + 1);
+            for (field_name, FieldUpdate { var, loc_expr, .. }) in updates.clone() {
+                let (var, tipe, con) =
+                    constrain_field_update(rigids, var, region, field_name.clone(), &loc_expr);
+                fields.insert(field_name, tipe);
+                vars.push(var);
+                cons.push(con);
+            }
+
+            let fields_type = Type::Record(fields.clone(), Box::new(Type::Variable(*ext_var)));
+            let record_type = Type::Variable(*record_var);
+
+            // NOTE from elm compiler: fields_type is separate so that Error propagates better
+            let fields_con = Eq(record_type.clone(), NoExpectation(fields_type), region);
+            let record_con = Eq(record_type.clone(), expected, region);
+
+            vars.push(*record_var);
+            vars.push(*ext_var);
+
+            cons.push(record_con);
+
+            let con = Lookup(
+                symbol.clone(),
+                ForReason(
+                    Reason::RecordUpdateKeys(name.clone(), fields),
+                    record_type,
+                    region,
+                ),
+                region,
+            );
+
+            cons.push(con);
+            cons.push(fields_con);
+
+            exists(vars, And(cons))
+        }
         Str(_) | BlockStr(_) => Eq(str_type(), expected, region),
         List(list_var, loc_elems) => {
             if loc_elems.is_empty() {
@@ -768,3 +814,19 @@ pub fn create_letrec_constraint(
         })),
     }))
 }
+
+#[inline(always)]
+fn constrain_field_update(
+    rigids: &Rigids,
+    var: Variable,
+    region: Region,
+    field: Lowercase,
+    loc_expr: &Located<Expr>,
+) -> (Variable, Type, Constraint) {
+    let field_type = Type::Variable(var);
+    let reason = Reason::RecordUpdateValue(field);
+    let expected = ForReason(reason, field_type.clone(), region);
+    let con = constrain_expr(rigids, loc_expr.region, &loc_expr.value, expected);
+
+    (var, field_type, con)
+}
diff --git a/src/types.rs b/src/types.rs
index c23359099c..d6efe4a4e1 100644
--- a/src/types.rs
+++ b/src/types.rs
@@ -273,6 +273,8 @@ pub enum Reason {
     InterpolatedStringVar,
     WhenBranch { index: usize },
     ElemInList,
+    RecordUpdateValue(Lowercase),
+    RecordUpdateKeys(Lowercase, SendMap<Lowercase, Type>),
 }
 
 #[derive(Debug, Clone, PartialEq)]
diff --git a/src/uniqueness/mod.rs b/src/uniqueness/mod.rs
index 40b43ff5de..f4f220c888 100644
--- a/src/uniqueness/mod.rs
+++ b/src/uniqueness/mod.rs
@@ -635,6 +635,8 @@ pub fn canonicalize_expr(
             (output, And(constraints))
         }
 
+        Update { .. } => panic!("TODO implement record update for uniq"),
+
         Access {
             ext_var,
             field_var,