Repository: tweag/nickel
Pull request #1165 (2023-03-08 12:20:40)

Use a custom debug instance for Closure
This instance hides the `env` field in `Closure` when printing. Usually the environment is too large to be helpful on a quick inspection and in fact causes stack overflows because of its deeply recursive structure in some cases.


Patch:
diff --git a/benches/mantis/lib.ncl b/benches/mantis/lib.ncl
index 165fbba9..9e22b440 100644
--- a/benches/mantis/lib.ncl
+++ b/benches/mantis/lib.ncl
@@ -19,15 +19,15 @@
         if str_match value then
           value
         else
-          contract.blame_with "no match" label
-      else contract.blame_with "not a string" label,
+          contract.blame_with_message "no match" label
+      else contract.blame_with_message "not a string" label,
     PseudoOr = fun alts label value =>
       array.fold_right (fun ctr rest =>
         if ctr.pred value then
           ctr.contract value
         else
           rest)
-        (contract.blame_with "no alternative matched" label),
+        (contract.blame_with_message "no alternative matched" label),
     OrableFromPred : (Dyn -> Bool)
                      -> {pred : Dyn -> Bool, contract: Dyn -> Dyn -> Dyn },
     OrableFromPred = fun pred_ => {
diff --git a/doc/manual/contracts.md b/doc/manual/contracts.md
index a710293d..99994193 100644
--- a/doc/manual/contracts.md
+++ b/doc/manual/contracts.md
@@ -61,21 +61,21 @@ let IsFoo = fun label value =>
     if value == "foo" then
       value
     else
-      contract.blame_with "not equal to \"foo\"" label
+      contract.blame_with_message "not equal to \"foo\"" label
   else
-    contract.blame_with "not a string" label
+    contract.blame_with_message "not a string" label
 ```
 
 A custom contract is a function of two arguments:
 
 - A `label`. Provided by the interpreter, the label contains tracking information
   for error reporting. Its main usage is to be passed to `contract.blame` or
-  `contract.blame_with` when the contract isn't satisfied.
+  `contract.blame_with_message` when the contract isn't satisfied.
 - The value being checked.
 
 Upon success, the contract must return the original value. We will see the
 reason why in the [laziness](#laziness) section. To signal failure, we use
-`contract.blame` or its variant `contract.blame_with` that takes an additional
+`contract.blame` or its variant `contract.blame_with_message` that takes an additional
 error message as a parameter. `blame` immediately aborts the execution and
 reports a contract violation error.
 
@@ -586,17 +586,17 @@ let NumBoolDict = fun label value =>
         if string.is_match "^\\d+$" field_name then
           acc # unused and always null through iteration
         else
-          contract.blame_with "field name `#{field_name}` is not a number" label
+          contract.blame_with_message "field name `#{field_name}` is not a number" label
         ) null in
 
     value
       |> record.map (fun name value =>
         let label_with_msg =
-            contract.tag "field `#{name}` is not a boolean" label in
+            contract.label.with_message "field `#{name}` is not a boolean" label in
         contract.apply Bool label_with_msg value)
       |> builtin.seq check_fields
   else
-    contract.blame_with "not a record" label
+    contract.blame_with_message "not a record" label
 ```
 
 There is a lot to unwrap here. Please refer to the [syntax](./syntax.md) section
diff --git a/examples/config-gcc/config-gcc.ncl b/examples/config-gcc/config-gcc.ncl
index 487890b3..402cf023 100644
--- a/examples/config-gcc/config-gcc.ncl
+++ b/examples/config-gcc/config-gcc.ncl
@@ -11,20 +11,20 @@ let GccFlag =
       array.any (fun x => x == string.substring 0 1 value) available then
       value
     else
-      contract.blame_with "unknown flag %{value}" label
+      contract.blame_with_message "unknown flag %{value}" label
   else if builtin.is_record value then
     if record.has_field "flag" value && record.has_field "arg" value then
       if array.any (fun x => x == value.flag) available then
         #Normalize the tag to a string
         value.flag ++ value.arg
       else
-        contract.blame_with "unknown flag %{value.flag}" label
+        contract.blame_with_message "unknown flag %{value.flag}" label
     else
-      contract.blame_with
+      contract.blame_with_message
         "bad record structure: missing field `flag` or `arg`"
         label
   else
-    contract.blame_with "expected record or string" label in
+    contract.blame_with_message "expected record or string" label in
 
 let Path =
   let pattern = m%"^(.+)/([^/]+)$"% in
@@ -33,18 +33,18 @@ let Path =
       if string.is_match pattern value then
         value
       else
-        contract.blame_with "invalid path" label
+        contract.blame_with_message "invalid path" label
     else
-      contract.blame_with "not a string" label in
+      contract.blame_with_message "not a string" label in
 
 let SharedObjectFile = fun label value =>
   if builtin.is_str value then
     if string.is_match m%"\.so$"% value then
       value
     else
-      contract.blame_with "not an .so file" label
+      contract.blame_with_message "not an .so file" label
   else
-    contract.blame_with "not a string" label in
+    contract.blame_with_message "not a string" label in
 
 let OptLevel = fun label value =>
   if value == 0 || value == 1 || value == 2 then
diff --git a/lsp/nls/src/requests/completion.rs b/lsp/nls/src/requests/completion.rs
index bcbe5e33..fa001735 100644
--- a/lsp/nls/src/requests/completion.rs
+++ b/lsp/nls/src/requests/completion.rs
@@ -90,7 +90,7 @@ impl IdentWithType {
             if name.is_ascii() {
                 String::from(name)
             } else {
-                format!("\"{}\"", name)
+                format!("\"{name}\"")
             }
         }
         let doc = || {
@@ -814,7 +814,7 @@ mod tests {
             let actual = get_identifier_path(input);
             let expected: Option<Vec<_>> =
                 expected.map(|path| path.iter().map(|s| String::from(*s)).collect());
-            assert_eq!(actual, expected, "test failed: {}", case_name)
+            assert_eq!(actual, expected, "test failed: {case_name}")
         }
     }
 
diff --git a/src/eval/merge.rs b/src/eval/merge.rs
index 3a60680b..bcfb1397 100644
--- a/src/eval/merge.rs
+++ b/src/eval/merge.rs
@@ -242,22 +242,23 @@ pub fn merge<C: Cache>(
             } = hashmap::split(r1.fields, r2.fields);
 
             match mode {
-                MergeMode::Contract(mut lbl) if !r2.attrs.open && !left.is_empty() => {
+                MergeMode::Contract(label) if !r2.attrs.open && !left.is_empty() => {
                     let fields: Vec<String> =
                         left.keys().map(|field| format!("`{field}`")).collect();
                     let plural = if fields.len() == 1 { "" } else { "s" };
                     let fields_list = fields.join(",");
 
-                    lbl.set_diagnostic_message(format!("extra field{plural} {fields_list}"));
-                    lbl.set_diagnostic_notes(vec![
-                        format!("Have you misspelled a field?"),
-                        String::from("The record contract might also be too strict. By default, record contracts exclude any field which is not listed.
+                    let label = label
+                        .with_diagnostic_message(format!("extra field{plural} {fields_list}"))
+                        .with_diagnostic_notes(vec![
+                            String::from("Have you misspelled a field?"),
+                            String::from("The record contract might also be too strict. By default, record contracts exclude any field which is not listed.
 Append `, ..` at the end of the record contract, as in `{some_field | SomeContract, ..}`, to make it accept extra fields."),
-                    ]);
+                        ]);
 
                     return Err(EvalError::BlameError {
-                        evaluated_arg: lbl.get_evaluated_arg(cache),
-                        label: lbl,
+                        evaluated_arg: label.get_evaluated_arg(cache),
+                        label,
                         call_stack: CallStack::new(),
                     });
                 }
diff --git a/src/eval/mod.rs b/src/eval/mod.rs
index 5f59a8d4..d56d4c48 100644
--- a/src/eval/mod.rs
+++ b/src/eval/mod.rs
@@ -821,12 +821,20 @@ pub enum IdentKind {
 }
 
 /// A closure, a term together with an environment.
-#[derive(Debug, PartialEq)]
+#[derive(PartialEq)]
 pub struct Closure {
     pub body: RichTerm,
     pub env: Environment,
 }
 
+impl std::fmt::Debug for Closure {
+    fn fmt(&self, f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result {
+        f.debug_struct("Closure")
+            .field("body", &self.body)
+            .finish_non_exhaustive()
+    }
+}
+
 impl Clone for Closure {
     fn clone(&self) -> Self {
         Closure {
diff --git a/src/eval/operation.rs b/src/eval/operation.rs
index 1752c5c9..625dc2da 100644
--- a/src/eval/operation.rs
+++ b/src/eval/operation.rs
@@ -1309,6 +1309,25 @@ impl<R: ImportResolver, C: Cache> VirtualMachine<R, C> {
                     .map(|(next, ..)| next)
                     .ok_or_else(|| EvalError::NotEnoughArgs(2, String::from("trace"), pos_op))
             }
+            UnaryOp::LabelPushDiag() => {
+                match_sharedterm! {t, with {
+                    Term::Lbl(label) => {
+                        let mut label = label;
+                        label.push_diagnostic();
+                        Ok(Closure {
+                            body: RichTerm::new(Term::Lbl(label), pos),
+                            env
+                        })
+                    }
+                } else {
+                    Err(EvalError::TypeError(
+                        String::from("Label"),
+                        String::from("trace"),
+                        arg_pos,
+                        RichTerm { term: t, pos },
+                    )) }
+                }
+            }
         }
     }
 
@@ -1690,41 +1709,6 @@ impl<R: ImportResolver, C: Cache> VirtualMachine<R, C> {
                     ))
                 }
             }
-            BinaryOp::Tag() => match_sharedterm! {t1, with {
-                    Term::Str(s) => match_sharedterm!{t2, with {
-                                Term::Lbl(label) => {
-                                    let mut label = label;
-                                    label.set_diagnostic_message(s);
-
-                                    Ok(Closure::atomic_closure(RichTerm::new(
-                                        Term::Lbl(label),
-                                        pos_op_inh,
-                                    )))
-                                }
-                            } else {
-                                Err(EvalError::TypeError(
-                                    String::from("Label"),
-                                    String::from("tag, 2nd argument"),
-                                    snd_pos,
-                                    RichTerm {
-                                        term: t2,
-                                        pos: pos2,
-                                    },
-                                ))
-                            }
-                        }
-                } else {
-                    Err(EvalError::TypeError(
-                        String::from("Str"),
-                        String::from("tag, 1st argument"),
-                        fst_pos,
-                        RichTerm {
-                            term: t1,
-                            pos: pos1,
-                        },
-                    ))
-                }
-            },
             BinaryOp::Eq() => {
                 let mut env = Environment::new();
 
@@ -2629,6 +2613,139 @@ impl<R: ImportResolver, C: Cache> VirtualMachine<R, C> {
                     ))
                 }
             }
+            BinaryOp::LabelWithMessage() => {
+                let t1 = t1.into_owned();
+                let t2 = t2.into_owned();
+
+                let Term::Str(message) = t1 else {
+                    return Err(EvalError::TypeError(
+                        String::from("Str"),
+                        String::from("label_with_message, 1st argument"),
+                        fst_pos,
+                        RichTerm {
+                            term: t1.into(),
+                            pos: pos1,
+                        },
+                    ))
+                };
+
+                let Term::Lbl(label) = t2 else {
+                    return Err(EvalError::TypeError(
+                        String::from("Lbl"),
+                        String::from("label_with_message, 2nd argument"),
+                        snd_pos,
+                        RichTerm {
+                            term: t2.into(),
+                            pos: pos2,
+                        },
+                    ))
+                };
+
+                Ok(Closure::atomic_closure(RichTerm::new(
+                    Term::Lbl(label.with_diagnostic_message(message)),
+                    pos_op_inh,
+                )))
+            }
+            BinaryOp::LabelWithNotes() => {
+                let t2 = t2.into_owned();
+
+                // We need to extract plain strings from a Nickel array, which most likely
+                // contains at least generated variables.
+                // As for serialization, we thus fully substitute all variables first.
+                let t1_subst = subst(
+                    &self.cache,
+                    RichTerm {
+                        term: t1,
+                        pos: pos1,
+                    },
+                    &Environment::new(),
+                    &env1,
+                );
+                let t1 = t1_subst.term.into_owned();
+
+                let Term::Array(array, _) = t1 else {
+                    return Err(EvalError::TypeError(
+                        String::from("Array Str"),
+                        String::from("label_with_notes, 1st argument"),
+                        fst_pos,
+                        RichTerm {
+                            term: t1.into(),
+                            pos: pos1,
+                        },
+                    ));
+                };
+
+                let notes = array
+                    .into_iter()
+                    .map(|element| {
+                        let term = element.term.into_owned();
+
+                        if let Term::Str(s) = term {
+                            Ok(s)
+                        } else {
+                            Err(EvalError::TypeError(
+                                String::from("Str"),
+                                String::from("label_with_notes, element of 1st argument"),
+                                TermPos::None,
+                                RichTerm {
+                                    term: term.into(),
+                                    pos: element.pos,
+                                },
+                            ))
+                        }
+                    })
+                    .collect::<Result<Vec<_>, _>>()?;
+
+                let Term::Lbl(label) = t2 else {
+                    return Err(EvalError::TypeError(
+                        String::from("Lbl"),
+                        String::from("label_with_notes, 2nd argument"),
+                        snd_pos,
+                        RichTerm {
+                            term: t2.into(),
+                            pos: pos2,
+                        },
+                    ))
+                };
+
+                Ok(Closure::atomic_closure(RichTerm::new(
+                    Term::Lbl(label.with_diagnostic_notes(notes)),
+                    pos_op_inh,
+                )))
+            }
+            BinaryOp::LabelAppendNote() => {
+                let t1 = t1.into_owned();
+                let t2 = t2.into_owned();
+
+                let Term::Str(note) = t1 else {
+                    return Err(EvalError::TypeError(
+                        String::from("Str"),
+                        String::from("label_append_note, 1st argument"),
+                        fst_pos,
+                        RichTerm {
+                            term: t1.into(),
+                            pos: pos1,
+                        },
+                    ));
+                };
+
+                let Term::Lbl(label) = t2 else {
+                    return Err(EvalError::TypeError(
+                        String::from("Lbl"),
+                        String::from("label_append_note, 2nd argument"),
+                        snd_pos,
+                        RichTerm {
+                            term: t2.into(),
+                            pos: pos2,
+                        },
+                    ))
+                };
+
+                Ok(Closure::atomic_closure(RichTerm::new(
+                    Term::Lbl(label.append_diagnostic_note(note)),
+                    pos2.into_inherited(),
+                )))
+            }
         }
     }
 
diff --git a/src/label.rs b/src/label.rs
index 5c1d501e..88ef3e2e 100644
--- a/src/label.rs
+++ b/src/label.rs
@@ -430,47 +430,62 @@ impl Label {
     /// Set the message of the current diagnostic (the last diagnostic of the stack). Potentially
     /// erase the previous value.
     ///
-    /// If the diagnostic stack is empty, this methods pushes a new diagnostic with the given notes.
-    pub fn set_diagnostic_message(&mut self, message: impl Into<String>) {
+    /// If the diagnostic stack is empty, this method pushes a new diagnostic with the given notes.
+    pub fn with_diagnostic_message(mut self, message: impl Into<String>) -> Self {
         if let Some(current) = self.diagnostics.last_mut() {
             current.message = Some(message.into());
         } else {
             self.diagnostics
                 .push(ContractDiagnostic::new().with_message(message));
-        }
+        };
+
+        self
     }
 
     /// Set the notes of the current diagnostic (the last diagnostic of the stack). Potentially
     /// erase the previous value.
     ///
-    /// If the diagnostic stack is empty, this methods pushes a new diagnostic with the given notes.
-    pub fn set_diagnostic_notes(&mut self, notes: Vec<String>) {
+    /// If the diagnostic stack is empty, this method pushes a new diagnostic with the given notes.
+    pub fn with_diagnostic_notes(mut self, notes: Vec<String>) -> Self {
         if let Some(current) = self.diagnostics.last_mut() {
             current.notes = notes;
         } else {
             self.diagnostics
                 .push(ContractDiagnostic::new().with_notes(notes));
-        }
+        };
+
+        self
     }
 
     /// Append a note to the current diagnostic (the last diagnostic of the stack). Potentially
     /// erase the previous value.
     ///
-    /// If the diagnostic stack is empty, this methods pushes a new diagnostic with the given note.
-    pub fn append_diagnostic_note(&mut self, note: impl Into<String>) {
+    /// If the diagnostic stack is empty, this method pushes a new diagnostic with the given note.
+    pub fn append_diagnostic_note(mut self, note: impl Into<String>) -> Self {
         if let Some(current) = self.diagnostics.last_mut() {
             current.append_note(note);
         } else {
             self.diagnostics
                 .push(ContractDiagnostic::new().with_notes(vec![note.into()]));
-        }
+        };
+
+        self
     }
 
-    /// Return a reference to the current contract diagnostic, that is the last one of the stack,
-    /// if any.
+    /// Return a reference to the current contract diagnostic, which is the last element of the
+    /// stack, if any.
     pub fn current_diagnostic(&self) -> Option<&ContractDiagnostic> {
         self.diagnostics.last()
     }
+
+    /// Push a new, fresh diagnostic on the stack if the current diagnostic isn't empty. This has
+    /// the effect of saving the current diagnostic, that can't then be mutated anymore by the
+    /// label's API.
+    pub fn push_diagnostic(&mut self) {
+        if matches!(self.current_diagnostic(), Some(diag) if !diag.is_empty()) {
+            self.diagnostics.push(ContractDiagnostic::new());
+        }
+    }
 }
 
 impl Default for Label {
diff --git a/src/parser/grammar.lalrpop b/src/parser/grammar.lalrpop
index 6f1dbed0..be15d405 100644
--- a/src/parser/grammar.lalrpop
+++ b/src/parser/grammar.lalrpop
@@ -664,6 +664,7 @@ UOp: UnaryOp = {
     "rec_default_op" => UnaryOp::RecDefault(),
     "record_empty_with_tail" => UnaryOp::RecordEmptyWithTail(),
     "trace" => UnaryOp::Trace(),
+    "label_push_diag" => UnaryOp::LabelPushDiag(),
 };
 
 MatchCase: MatchCase = {
@@ -837,7 +838,6 @@ BOpPre: BinaryOp = {
     "go_field" => BinaryOp::GoField(),
     "has_field" => BinaryOp::HasField(),
     "elem_at" => BinaryOp::ArrayElemAt(),
-    "tag" => BinaryOp::Tag(),
     "hash" => BinaryOp::Hash(),
     "serialize" => BinaryOp::Serialize(),
     "deserialize" => BinaryOp::Deserialize(),
@@ -850,6 +850,9 @@ BOpPre: BinaryOp = {
         pending_contracts: Default::default(),
     },
     "record_remove" => BinaryOp::DynRemove(),
+    "label_with_message" => BinaryOp::LabelWithMessage(),
+    "label_with_notes" => BinaryOp::LabelWithNotes(),
+    "label_append_note" => BinaryOp::LabelAppendNote(),
 }
 
 NOpPre<ArgRule>: UniTerm = {
@@ -982,7 +985,6 @@ extern {
         "Bool" => Token::Normal(NormalToken::Bool),
         "Array" => Token::Normal(NormalToken::Array),
 
-        "tag" => Token::Normal(NormalToken::Tag),
         "typeof" => Token::Normal(NormalToken::Typeof),
         "assume" => Token::Normal(NormalToken::Assume),
         "array_lazy_assume" => Token::Normal(NormalToken::ArrayLazyAssume),
@@ -1050,6 +1052,10 @@ extern {
         "str_from" => Token::Normal(NormalToken::ToStr),
         "num_from" => Token::Normal(NormalToken::NumFromStr),
         "enum_from" => Token::Normal(NormalToken::EnumFromStr),
+        "label_with_message" => Token::Normal(NormalToken::LabelWithMessage),
+        "label_with_notes" => Token::Normal(NormalToken::LabelWithNotes),
+        "label_append_note" => Token::Normal(NormalToken::LabelAppendNote),
+        "label_push_diag" => Token::Normal(NormalToken::LabelPushDiag),
 
         "{" => Token::Normal(NormalToken::LBrace),
         "}" => Token::Normal(NormalToken::RBrace),
diff --git a/src/parser/lexer.rs b/src/parser/lexer.rs
index f4f64e8b..f969e5e0 100644
--- a/src/parser/lexer.rs
+++ b/src/parser/lexer.rs
@@ -175,8 +175,6 @@ pub enum NormalToken<'input> {
     #[regex("[a-zA-Z][_a-zA-Z0-9-']*-s(%+)\"", symbolic_string_prefix_and_length)]
     SymbolicStringStart(SymbolicStringStart<'input>),
 
-    #[token("%tag%")]
-    Tag,
     #[token("%typeof%")]
     Typeof,
 
@@ -310,6 +308,14 @@ pub enum NormalToken<'input> {
     NumFromStr,
     #[token("%enum_from_str%")]
     EnumFromStr,
+    #[token("%label_with_message%")]
+    LabelWithMessage,
+    #[token("%label_with_notes%")]
+    LabelWithNotes,
+    #[token("%label_append_note%")]
+    LabelAppendNote,
+    #[token("%label_push_diag%")]
+    LabelPushDiag,
 
     #[token("{")]
     LBrace,
diff --git a/src/term/mod.rs b/src/term/mod.rs
index b804bd84..90aa14e0 100644
--- a/src/term/mod.rs
+++ b/src/term/mod.rs
@@ -937,6 +937,12 @@ impl From<SharedTerm> for Term {
     }
 }
 
+impl From<Term> for SharedTerm {
+    fn from(t: Term) -> Self {
+        SharedTerm::new(t)
+    }
+}
+
 impl Deref for SharedTerm {
     type Target = Term;
 
@@ -1162,6 +1168,13 @@ pub enum UnaryOp {
     /// on the top of the stack. Operationally the same as the identity
     /// function
     Trace(),
+
+    /// Push a new, fresh diagnostic on the diagnostic stack of a contract label. This has the
+    /// effect of saving the current diagnostic, as following calls to primop that modifies the
+    /// label's current diagnostic will modify the fresh one, istead of the one being stacked.
+    /// This primop shouldn't be used directly by user a priori, but is used internally during e.g.
+    /// contract application.
+    LabelPushDiag(),
 }
 
 // See: https://github.com/rust-lang/regex/issues/178
@@ -1260,8 +1273,6 @@ pub enum BinaryOp {
     ///
     /// See `GoDom`.
     GoField(),
-    /// Set the tag text of a blame label.
-    Tag(),
     /// Extend a record with a dynamic field.
     ///
     /// Dynamic means that the field name may be an expression instead of a statically known
@@ -1319,6 +1330,13 @@ pub enum BinaryOp {
     /// contract `C` attached to each of them. Then uses `NAryOp::MergeContract` to
     /// apply this record contract to `R`.
     DictionaryAssume(),
+
+    /// Set the message of the current diagnostic of a label.
+    LabelWithMessage(),
+    /// Set the notes of the current diagnostic of a label.
+    LabelWithNotes(),
+    /// Append a note to the current diagnostic of a label.
+    LabelAppendNote(),
 }
 
 impl BinaryOp {
diff --git a/src/typecheck/operation.rs b/src/typecheck/operation.rs
index 5a857b01..f2a41fc2 100644
--- a/src/typecheck/operation.rs
+++ b/src/typecheck/operation.rs
@@ -220,6 +220,9 @@ pub fn get_uop_type(
             let ty = UnifType::UnifVar(state.table.fresh_type_var_id());
             (mk_uniftype::str(), mk_uty_arrow!(ty.clone(), ty))
         }
+        // Morally: Lbl -> Lbl
+        // Actual: Dyn -> Dyn
+        UnaryOp::LabelPushDiag() => (mk_uniftype::dynamic(), mk_uniftype::dynamic()),
     })
 }
 
@@ -256,12 +259,6 @@ pub fn get_bop_type(
             mk_uniftype::dynamic(),
             mk_uty_arrow!(TypeF::Dyn, TypeF::Dyn),
         ),
-        // Str -> Dyn -> Dyn
-        BinaryOp::Tag() => (
-            mk_uniftype::str(),
-            mk_uniftype::dynamic(),
-            mk_uniftype::dynamic(),
-        ),
         // forall a b. a -> b -> Bool
         BinaryOp::Eq() => (
             UnifType::UnifVar(state.table.fresh_type_var_id()),
@@ -405,6 +402,27 @@ pub fn get_bop_type(
                 mk_uty_arrow!(mk_uniftype::dynamic(), ty_dict),
             )
         }
+        // Morally: Str -> Lbl -> Lbl
+        // Actual: Str -> Dyn -> Dyn
+        BinaryOp::LabelWithMessage() => (
+            mk_uniftype::str(),
+            mk_uniftype::dynamic(),
+            mk_uniftype::dynamic(),
+        ),
+        // Morally: Array Str -> Lbl -> Lbl
+        // Actual: Array Str -> Dyn -> Dyn
+        BinaryOp::LabelWithNotes() => (
+            mk_uniftype::array(TypeF::Str),
+            mk_uniftype::dynamic(),
+            mk_uniftype::dynamic(),
+        ),
+        // Morally: Str -> Lbl -> Lbl
+        // Actual: Str -> Dyn -> Dyn
+        BinaryOp::LabelAppendNote() => (
+            mk_uniftype::str(),
+            mk_uniftype::dynamic(),
+            mk_uniftype::dynamic(),
+        ),
     })
 }
 
diff --git a/stdlib/array.ncl b/stdlib/array.ncl
index 36a24a48..f75dab49 100644
--- a/stdlib/array.ncl
+++ b/stdlib/array.ncl
@@ -17,9 +17,9 @@
          if %length% value != 0 then
            value
          else
-           %blame% (%tag% "empty array" label)
+           %blame% (%label_with_message% "empty array" label)
        else
-         %blame% (%tag% "not a array" label),
+         %blame% (%label_with_message% "not a array" label),
 
     first : forall a. Array a -> a
       | doc m%"
@@ -132,9 +132,9 @@
         let length = %length% l in
         if length == 0 then acc
         else
-          let rec go = fun acc n => 
+          let rec go = fun acc n =>
             if n == length then acc
-            else 
+            else
               let next_acc = %elem_at% l n |> f acc in
               %seq% next_acc (go next_acc (n+1))
           in
@@ -156,7 +156,7 @@
         let length = %length% l in
         let rec go = fun n =>
           if n == length then
-            fst 
+            fst
           else
             go (n+1)
             |> f (%elem_at% l n)
diff --git a/stdlib/builtin.ncl b/stdlib/builtin.ncl
index 1f23d90d..924015d0 100644
--- a/stdlib/builtin.ncl
+++ b/stdlib/builtin.ncl
@@ -244,7 +244,7 @@
           │ ^ applied to this expression
       ```
     "%
-    = fun msg label value => contract.blame_with msg label,
+    = fun msg label value => contract.blame_with_message msg label,
 
     fail_with | Str -> Dyn
     | doc m%"
diff --git a/stdlib/contract.ncl b/stdlib/contract.ncl
index 3b29ce96..b891da2a 100644
--- a/stdlib/contract.ncl
+++ b/stdlib/contract.ncl
@@ -5,103 +5,249 @@
         Raise blame for a given label.
 
         Type: `forall a. Lbl -> a`
-        (for technical reasons, this element isn't actually statically typed)
+        (for technical reasons, this function isn't actually statically typed)
 
         Blame is the mechanism to signal contract violiation in Nickel. It ends
         the program execution and print a detailed report thanks to the
         information tracked inside the label.
 
         For example:
+
         ```nickel
         IsZero = fun label value =>
-          if value == 0 then value
-          else contract.blame label
+          if value == 0 then
+            value
+          else
+            contract.blame label
         ```
         "%
-      = fun l => %blame% l,
+      = fun label => %blame% label,
 
-    blame_with
+    blame_with_message
       | doc m%"
         Raise blame with respect to a given label and a custom error message.
 
         Type: `forall a. Str -> Lbl -> a`
-        (for technical reasons, this element isn't actually statically typed)
+        (for technical reasons, this function isn't actually statically typed)
 
         Same as `blame`, but take an additional custom error message that will be
-        displayed as part of the blame error. `blame_with msg l` is equivalent to
-        `blame (tag msg l)
+        displayed as part of the blame error. `blame_with_message message label`
+        is equivalent to `blame (label.with_message message label)`
 
         For example:
+
         ```nickel
         let IsZero = fun label value =>
-          if value == 0 then value
-          else contract.blame_with "Not zero" label in
+          if value == 0 then
+            value
+          else
+            contract.blame_with_message_message "Not zero" label
+        in
+
         0 | IsZero
         ```
         "%
-      = fun msg l => %blame% (%tag% msg l),
+      = fun message label => %blame% (%label_with_message% message label),
 
     from_predicate
       | doc m%"
         Generate a contract from a boolean predicate.
 
         Type: `(Dyn -> Bool) -> (Lbl -> Dyn -> Dyn)`
-        (for technical reasons, this element isn't actually statically typed)
+        (for technical reasons, this function isn't actually statically typed)
 
         For example:
-        ```
+
+        ```nickel
         let IsZero = contract.from_predicate (fun x => x == 0) in
         0 | IsZero
         ```
         "%
-      = fun pred l v => if pred v then v else %blame% l,
+      = fun pred label value => if pred value then value else %blame% label,
 
-    tag
+    label
       | doc m%"
-        Attach a tag, or a custom error message, to a label. If a tag was
-        previously set, it is erased.
-
-        Type: `Str -> Lbl -> Lbl`
-        (for technical reasons, this element isn't actually statically typed)
-
-        For example:
-        ```
-        let ContractNum = contract.from_predicate (fun x => x > 0 && x < 50) in
-        Contract = fun label value =>
-          if builtin.is_num value then
-            ContractNum
-              (contract.tag "num subcontract failed! (out of bound)" label)
-              value
-          else
-            value in
-        5 | Contract
-        ```
+          The label submodule, which gathers functions that manipulate the label
+          of a contract.
+
+          A label is a special opaque value automatically passed by the Nickel
+          interpreter to contracts when performing a contract check.
+
+          A label stores a stack of custom error diagnostics, that can be
+          manipulated by the function of this module. Labels thus offer a way to
+          customize the error message that will be shown if the contract is broken.
+
+          The setters (`with_XXX` functions) always operate on the current error
+          diagnostic, which is the last diagnotic on the stack (if the stack is
+          empty, a fresh diagnostic is silently created when using a setter).
+          The previous diagnostics are thus archived, and can't be modified
+          anymore. All diagnostics will be shown during error reporting, with
+          the most recent being used as the main one.
+
+          `contract.apply` is the operation that pushes a new fresh diagnostic on
+          the stack, saving the previously current error diagnostic. Indeed,
+          `contract.apply` is mostly used to apply subcontracts inside a parent
+          contract. Stacking the current diagnostic potentially customized by
+          the parent contract saves the information inside, and provides a fresh
+          diagnostic for the child contract to use.
         "%
-      = fun msg l => %tag% msg l,
+      = {
+        with_message
+          | doc m%"
+            Attach a custom error message to the current error diagnostic of a
+            label.
+
+            Type: `Str -> Lbl -> Lbl`
+            (for technical reasons, this function isn't actually statically typed)
+
+            If a custom error message was previously set, there are two
+            possibilities:
+              - the label has gone through a `contract.apply` call in-between.
+                In this case, the previous diagnostic has been stacked,
+                and using `with_message` won't erase anything but rather modify
+                the fresh current diagnostic.
+              - no `contract.apply` has taken place since the last message was
+                set. In this case, the current diagnostic is still the same, and
+                the previous error message will be erased.
+
+            For example:
+
+            ```nickel
+            let ContractNum = contract.from_predicate (fun x => x > 0 && x < 50) in
+
+            let Contract = fun label value =>
+              if builtin.is_num value then
+                contract.apply
+                  ContractNum
+                  (contract.label.with_message
+                    "num subcontract failed! (out of bound)"
+                    label
+                  )
+                  value
+              else
+                value
+            in
+
+            5 | Contract
+            ```
+            "%
+          = fun message label => %label_with_message% message label,
+
+        with_notes
+          | doc m%"
+            Attach custom error notes to the current error diagnostic of a
+            label.
+
+            Type: `Array Str -> Lbl -> Lbl`
+            (for technical reasons, this function isn't actually statically typed)
+
+            If custom error notes were previously set, there are two
+            possibilities:
+              - the label has gone through a `contract.apply` call in-between.
+                In this case, the previous diagnostic has been stacked,
+                and using `with_notes` won't erase anything but rather modify
+                the fresh current diagnostic.
+              - no `contract.apply` has taken place since the last message was
+                set. In this case, the current diagnostic is still the same, and
+                the previous error notes will be erased.
+
+            For example:
+
+            ```nickel
+            let ContractNum = contract.from_predicate (fun x => x > 0 && x < 50) in
+
+            let Contract = fun label value =>
+              if builtin.is_num value then
+                contract.apply
+                  ContractNum
+                  (label
+                   |> contract.label.with_message "num subcontract failed! (out of bound)"
+                   |> contract.label.with_notes [
+                        "The value was a number, but this number is out of the expected bound",
+                        "The value must be a number between 0 and 50, both excluded",
+                      ]
+                  )
+                  value
+              else
+                value
+            in
+
+            5 | Contract
+            ```
+            "%
+          # the %label_with_notes% operator expect an array of strings which is
+          # fully evaluated, thus we force the notes first
+          = fun notes label => %label_with_notes% (%force% notes) label,
+
+        append_note
+          | doc m%"
+              Append a note to the notes of the current diagnostic of a label.
+
+              Type: `Str -> Lbl -> Lbl`
+              (for technical reasons, this function isn't actually statically typed)
+            "%
+          = fun note label => %label_append_note% note label,
+    },
 
     apply
       | doc m%"
-        Apply a contract to a label and a value.
-
-        Type: `Contract -> Lbl -> Dyn -> Dyn`
-        (for technical reasons, this element isn't actually statically typed)
-
-        Nickel supports user-defined contracts defined as functions, but also as
-        records. Moreover, the interpreter performs additional book-keeping for
-        error reporting when applying a contract in an expression `value |
-        Contract`. You should not use standard function application to apply a
-        contract, but this function instead.
-
-        For example:
-        ```
-        let Nullable = fun param_contract label value =>
-          if value == null then null
-          else contract.apply param_contract label value
-        in
-        let Contract = Nullable {foo | Num} in
-        ({foo = 1} | Contract)
-        ```
+          Apply a contract to a label and a value.
+
+          Type: `Contract -> Lbl -> Dyn -> Dyn`
+          (for technical reasons, this function isn't actually statically typed)
+
+          Nickel supports user-defined contracts defined as functions, but also
+          as records. Moreover, the interpreter performs additional book-keeping
+          for error reporting when applying a contract in an expression
+          `value | Contract`. You should not use standard function application
+          to apply a contract, but this function instead.
+
+          # Example
+
+          ```nickel
+          let Nullable = fun param_contract label value =>
+            if value == null then null
+            else contract.apply param_contract label value
+          in
+          let Contract = Nullable {foo | Num} in
+          ({foo = 1} | Contract)
+          ```
+
+          # Diagnostic stack
+
+          Using `apply` will stack the current custom reporting data, and create a
+          fresh current working diagnostic. `apply` thus acts automatically as a
+          split point between a contract and its subcontracts, providing the
+          subcontracts with a fresh diagnostic to use, while remembering the
+          previous diagnostics set by parent contracts.
+
+          ## Illustration
+
+          ```nickel
+          let ChildContract = fun label value =>
+            label
+            |> contract.label.with_message "child's message"
+            |> contract.label.append_note "child's note"
+            |> contract.blame
+          in
+
+          let ParentContract = fun label value =>
+            let label =
+              label
+              |> contract.label.with_message "parent's message"
+              |> contract.label.append_note "parent's note"
+            in
+            contract.apply ChildContract label value
+          in
+
+          null | ParentContract
+          ```
+
+          This example will print two diagnostics: the main one, using the
+          message and note of the child contract, and a secondary diagnostic,
+          using the parent contract message and note.
         "%
-      = fun contract label value => %assume% contract label value,
+      = fun contract label value =>
+        %assume% contract (%label_push_diag% label) value,
   },
 }
diff --git a/stdlib/internals.ncl b/stdlib/internals.ncl
index 90e32c74..912890ac 100644
--- a/stdlib/internals.ncl
+++ b/stdlib/internals.ncl
@@ -40,10 +40,10 @@
       if %typeof% t == `Enum then
           %assume% case l t
       else
-          %blame% (%tag% "not an enum tag" l),
+          %blame% (%label_with_message% "not an enum tag" l),
 
   "$enum_fail" = fun l =>
-      %blame% (%tag% "tag not included in the enum type" l),
+      %blame% (%label_with_message% "tag not included in the enum type" l),
 
   "$record" = fun field_contracts tail_contract l t =>
     if %typeof% t == `Record then
@@ -79,24 +79,24 @@
         in
         tail_contract fields_with_contracts l tail_fields
       else
-        %blame% (%tag% "missing field %{%head% missing_fields}" l)
+        %blame% (%label_with_message% "missing field %{%head% missing_fields}" l)
     else
-      %blame% (%tag% "not a record" l),
+      %blame% (%label_with_message% "not a record" l),
 
   "$dyn_record" = fun contr l t =>
       if %typeof% t == `Record then
           %dictionary_assume% (%go_dict% l) t contr
       else
-          %blame% (%tag% "not a record" l),
+          %blame% (%label_with_message% "not a record" l),
 
   "$forall_tail" = fun sy pol acc l t =>
       if pol == (%polarity% l) then
           if t == {} then
-            let tagged_l = %tag% "polymorphic tail mismatch" l in
+            let tagged_l = %label_with_message% "polymorphic tail mismatch" l in
             let tail = %record_unseal_tail% sy tagged_l t in
             acc & tail
           else
-            %blame% (%tag% "extra field `%{%head% (%fields% t)}`" l)
+            %blame% (%label_with_message% "extra field `%{%head% (%fields% t)}`" l)
       else
           # Note: in order to correctly attribute blame, the polarity of `l`
           # must match the polarity of the `forall` which introduced the
@@ -109,7 +109,7 @@
 
   "$empty_tail" = fun acc l t =>
       if t == {} then acc
-      else %blame% (%tag% "extra field `%{%head% (%fields% t)}`" l),
+      else %blame% (%label_with_message% "extra field `%{%head% (%fields% t)}`" l),
 
   # Recursive priorities operators
 
diff --git a/stdlib/num.ncl b/stdlib/num.ncl
index f47ea6af..0499d1b3 100644
--- a/stdlib/num.ncl
+++ b/stdlib/num.ncl
@@ -17,9 +17,9 @@
         if value % 1 == 0 then
           value
         else
-          %blame% (%tag% "not an integer" label)
+          %blame% (%label_with_message% "not an integer" label)
       else
-        %blame% (%tag% "not a number" label),
+        %blame% (%label_with_message% "not a number" label),
 
     Nat
     | doc m%"
@@ -40,9 +40,9 @@
         if value % 1 == 0 && value >= 0 then
           value
         else
-          %blame% (%tag% "not a natural" label)
+          %blame% (%label_with_message% "not a natural" label)
       else
-        %blame% (%tag% "not a number" label),
+        %blame% (%label_with_message% "not a number" label),
 
     PosNat
     | doc m%"
@@ -63,9 +63,9 @@
         if value % 1 == 0 && value > 0 then
           value
         else
-          %blame% (%tag% "not positive integer" label)
+          %blame% (%label_with_message% "not positive integer" label)
       else
-        %blame% (%tag% "not a number" label),
+        %blame% (%label_with_message% "not a number" label),
 
     NonZero
     | doc m%"
@@ -84,9 +84,9 @@
         if value != 0 then
           value
         else
-          %blame% (%tag% "non-zero" label)
+          %blame% (%label_with_message% "non-zero" label)
       else
-        %blame% (%tag% "not a number" label),
+        %blame% (%label_with_message% "not a number" label),
 
     is_integer : Num -> Bool
     | doc m%"
diff --git a/stdlib/string.ncl b/stdlib/string.ncl
index c83cb7b7..719e03f1 100644
--- a/stdlib/string.ncl
+++ b/stdlib/string.ncl
@@ -22,9 +22,9 @@
         else if s == "false" || s == "False" then
           "false"
         else
-          %blame% (%tag% "expected \"true\" or \"false\", got %{s}" l)
+          %blame% (%label_with_message% "expected \"true\" or \"false\", got %{s}" l)
       else
-        %blame% (%tag% "not a string" l),
+        %blame% (%label_with_message% "not a string" l),
 
     NumLiteral
     | doc m%"
@@ -47,9 +47,9 @@
           if is_num_literal s then
             s
           else
-            %blame% (%tag% "invalid num literal" l)
+            %blame% (%label_with_message% "invalid num literal" l)
         else
-          %blame% (%tag% "not a string" l),
+          %blame% (%label_with_message% "not a string" l),
 
     Character
     | doc m%"
@@ -72,9 +72,9 @@
         if length s == 1 then
           s
         else
-          %blame% (%tag% "length different than one" l)
+          %blame% (%label_with_message% "length different than one" l)
       else
-        %blame% (%tag% "not a string" l),
+        %blame% (%label_with_message% "not a string" l),
 
     EnumTag
     | doc m%"
@@ -142,9 +142,9 @@
         if %str_length% s > 0 then
           s
         else
-          %blame% (%tag% "empty string" l)
+          %blame% (%label_with_message% "empty string" l)
       else
-        %blame% (%tag% "not a string" l),
+        %blame% (%label_with_message% "not a string" l),
 
     join : Str -> Array Str -> Str
     | doc m%"


Test patch:
diff --git a/tests/snapshot/README.md b/tests/snapshot/README.md
index b8e53d03..33a042e1 100644
--- a/tests/snapshot/README.md
+++ b/tests/snapshot/README.md
@@ -22,7 +22,7 @@ please read [this section](#without-cargo-insta).
 
 1. Run `cargo insta review`.
 2. Check the output to see what changed
-  
+
 ## How to add a new snapshot test
 
 1. Add the Nickel file whose output you want to test into one of the
diff --git a/tests/snapshot/inputs/errors/contract_with_custom_diagnostic.ncl b/tests/snapshot/inputs/errors/contract_with_custom_diagnostic.ncl
new file mode 100644
index 00000000..704754da
--- /dev/null
+++ b/tests/snapshot/inputs/errors/contract_with_custom_diagnostic.ncl
@@ -0,0 +1,11 @@
+let Contract = fun label _value =>
+  label
+  |> contract.label.with_message "main error message"
+  |> contract.label.with_notes [
+      "This is the first note",
+      "This is the second note"
+    ]
+  |> contract.blame
+in
+
+null | Contract
diff --git a/tests/snapshot/inputs/errors/subcontract_nested_custom_diagnostics.ncl b/tests/snapshot/inputs/errors/subcontract_nested_custom_diagnostics.ncl
new file mode 100644
index 00000000..d154a5da
--- /dev/null
+++ b/tests/snapshot/inputs/errors/subcontract_nested_custom_diagnostics.ncl
@@ -0,0 +1,17 @@
+let ChildContract = fun label value =>
+  label
+  |> contract.label.with_message "child's message"
+  |> contract.label.append_note "child's note"
+  |> contract.blame
+in
+
+let ParentContract = fun label value =>
+  let label =
+    label
+    |> contract.label.with_message "parent's message"
+    |> contract.label.append_note "parent's note"
+  in
+  contract.apply ChildContract label value
+in
+
+null | ParentContract
diff --git a/tests/snapshot/snapshots/snapshot__error_contract_with_custom_diagnostic.ncl.snap b/tests/snapshot/snapshots/snapshot__error_contract_with_custom_diagnostic.ncl.snap
new file mode 100644
index 00000000..48b360a7
--- /dev/null
+++ b/tests/snapshot/snapshots/snapshot__error_contract_with_custom_diagnostic.ncl.snap
@@ -0,0 +1,25 @@
+---
+source: tests/snapshot/main.rs
+expression: snapshot
+---
+error: contract broken by a value: main error message
+   ┌─ :1:1
+   │
+ 1 │ Contract
+   │ -------- expected type
+   │
+   ┌─ [INPUTS_PATH]/errors/contract_with_custom_diagnostic.ncl:11:1
+   │
+11 │ null | Contract
+   │ ^^^^ applied to this expression
+   │
+   = This is the first note
+   = This is the second note
+
+note: 
+   ┌─ [INPUTS_PATH]/errors/contract_with_custom_diagnostic.ncl:11:8
+   │
+11 │ null | Contract
+   │        ^^^^^^^^ bound here
+
+
diff --git a/tests/snapshot/snapshots/snapshot__error_subcontract_nested_custom_diagnostics.ncl.snap b/tests/snapshot/snapshots/snapshot__error_subcontract_nested_custom_diagnostics.ncl.snap
new file mode 100644
index 00000000..e15e98e0
--- /dev/null
+++ b/tests/snapshot/snapshots/snapshot__error_subcontract_nested_custom_diagnostics.ncl.snap
@@ -0,0 +1,27 @@
+---
+source: tests/snapshot/main.rs
+expression: snapshot
+---
+error: contract broken by a value: child\'s message
+  ┌─ :1:1
+  │
+1 │ ParentContract
+  │ -------------- expected type
+  │
+  ┌─ <unknown> (generated by evaluation):1:1
+  │
+1 │ value
+  │ ----- evaluated to this value
+  │
+  = child's note
+
+note: 
+   ┌─ [INPUTS_PATH]/errors/subcontract_nested_custom_diagnostics.ncl:17:8
+   │
+17 │ null | ParentContract
+   │        ^^^^^^^^^^^^^^ bound here
+
+note: from a parent contract violation: parent\'s message
+ = parent's note
+
+