Repository: tweag/nickel
Pull request #1156 (2023-03-03 17:57:00)

Add primops to access the current diagnostic of a label
A previous PR (#1152) introduced a more fine-grained interface for contract labels, in order to customize error diagnostic. This PR add the Nickel primops to make this interface accessible to usercode, as well as the corresponding stdlib functions.

## Content

- Adds `label_with_message`, `label_with_notes`, `label_append_note`, `label_push_diag` primops, calling the corresponding methods on `Label`
- Adds corresponding functions in the stdlib, under the `contract.label` submodule
- Gets rid of `%tag%` and `contract.tag`, superseded by `%label_with_message%` and `contract.label.with_message`
- Renames accordingly `contract.blame_with` to `contract.blame_with_message`
- Makes `contract.apply` to automatically call `%label_push_diag%`. This means that `contract.apply` becomes the implicit split point between a parent contract and children subcontracts: it will stack any previously set custom diagnostic, which will save it from further modifications. Later calls to e.g. `contract.label.with_error_message` will modify a new, fresh diagnostic. All stacked diagnostics are printed during error reporting, in reverse order.


Patch:
diff --git a/benches/mantis/lib.ncl b/benches/mantis/lib.ncl
index 8fb7e516..f3824702 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 (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 162e72ff..d7920be0 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/linearization/completed.rs b/lsp/nls/src/linearization/completed.rs
index e61b28d3..4c13f65d 100644
--- a/lsp/nls/src/linearization/completed.rs
+++ b/lsp/nls/src/linearization/completed.rs
@@ -168,7 +168,14 @@ impl Completed {
             if let Some(doc) = doc {
                 extra.push(doc.to_owned());
             }
-
+            if let Some(custom_contract_msg) = annotation
+                .types
+                .as_ref()
+                .and_then(|ty| ty.label.current_diagnostic())
+                .and_then(|diag| diag.message.as_ref())
+            {
+                extra.push(custom_contract_msg.clone());
+            }
             if let Some(contracts) = annotation.contracts_to_string() {
                 extra.push(contracts);
             }
diff --git a/lsp/nls/src/requests/completion.rs b/lsp/nls/src/requests/completion.rs
index 4aab7d6d..57029232 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 = || {
@@ -810,7 +810,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/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 f3f42ac2..74952dae 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 87c9d207..34df4b1c 100644
--- a/src/parser/grammar.lalrpop
+++ b/src/parser/grammar.lalrpop
@@ -661,6 +661,7 @@ UOp: UnaryOp = {
     "rec_default_op" => UnaryOp::RecDefault(),
     "record_empty_with_tail" => UnaryOp::RecordEmptyWithTail(),
     "trace" => UnaryOp::Trace(),
+    "label_push_diag" => UnaryOp::LabelPushDiag(),
 };
 
 MatchCase: MatchCase = {
@@ -834,7 +835,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(),
@@ -847,6 +847,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 = {
@@ -977,7 +980,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),
@@ -1045,6 +1047,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 b349883f..1ef8a012 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 30652e4e..137747a3 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),
 
     head : forall a. Array a -> a
       | doc m%"
@@ -112,9 +112,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
@@ -136,7 +136,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 9be3764e..865922d1 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 3e4f293c..241980c4 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 667b554f..4af6eb64 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_int : Num -> Bool
     | doc m%"
diff --git a/stdlib/string.ncl b/stdlib/string.ncl
index 92617673..1a021714 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),
 
     CharLiteral
     | 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
+
+