Add a contract node to the AST

core/src/eval/mod.rs

@@ -74,13 +74,12 @@
 //! appear inside recursive records. A dedicated garbage collector is probably something to
 //! consider at some point.
 
-use crate::identifier::Ident;
-use crate::term::string::NickelString;
 use crate::{
     cache::{Cache as ImportCache, Envs, ImportResolver},
     closurize::{closurize_rec_record, Closurize},
     environment::Environment as GenericEnvironment,
     error::{Error, EvalError},
+    identifier::Ident,
     identifier::LocIdent,
     match_sharedterm,
     position::TermPos,
@@ -90,8 +89,9 @@ use crate::{
         make as mk_term,
         pattern::compile::Compile,
         record::{Field, RecordData},
-        BinaryOp, BindingType, LetAttrs, MatchBranch, MatchData, RecordOpKind, RichTerm,
-        RuntimeContract, StrChunk, Term, UnaryOp,
+        string::NickelString,
+        BinaryOp, BindingType, CustomContract, LetAttrs, MatchBranch, MatchData, RecordOpKind,
+        RichTerm, RuntimeContract, StrChunk, Term, UnaryOp,
     },
 };
 
@@ -1151,6 +1151,7 @@ pub fn subst<C: Cache>(
         // Do not substitute under lambdas: mutually recursive function could cause an infinite
         // loop. Although avoidable, this requires some care and is not currently needed.
         | v @ Term::Fun(..)
+        | v @ Term::CustomContract(CustomContract::Predicate(..))
         | v @ Term::Lbl(_)
         | v @ Term::ForeignId(_)
         | v @ Term::SealingKey(_)

core/src/eval/operation.rs

@@ -1194,6 +1194,19 @@ impl<R: ImportResolver, C: Cache> VirtualMachine<R, C> {
                     _ => Err(mk_type_error!("label_push_diag", "Label")),
                 })
             }
+            UnaryOp::ContractFromPredicate => {
+                if let Term::Fun(id, body) = &*t {
+                    Ok(Closure {
+                        body: RichTerm::new(
+                            Term::CustomContract(CustomContract::Predicate(*id, body.clone())),
+                            pos,
+                        ),
+                        env,
+                    })
+                } else {
+                    Err(mk_type_error!("contract_from_predicate", "Function"))
+                }
+            }
             #[cfg(feature = "nix-experimental")]
             UnaryOp::EvalNix => {
                 if let Term::Str(s) = &*t {
@@ -1539,6 +1552,16 @@ impl<R: ImportResolver, C: Cache> VirtualMachine<R, C> {
                             },
                             env: env1,
                         }),
+                        Term::CustomContract(CustomContract::Predicate(ref id, ref body)) => {
+                            Ok(Closure {
+                                body: mk_app!(
+                                    internals::predicate_to_ctr(),
+                                    RichTerm::new(Term::Fun(*id, body.clone()), pos1)
+                                )
+                                .with_pos(pos1),
+                                env: env1,
+                            })
+                        }
                         Term::Record(..) => {
                             let closurized = RichTerm {
                                 term: t1,

core/src/parser/grammar.lalrpop

@@ -788,7 +788,7 @@ EnumVariantPattern: EnumPattern = {
 // A twisted version of EnumPattern made specifically for the branch of an
 // or-pattern. As we parse `EnumVariantOrPattern` and treat it specifically in
 // an `or` branch (`OrPatternBranch`), we need to remove it from the enum
-// pattern rule. 
+// pattern rule.
 EnumPatternOrBranch: EnumPattern = {
     EnumVariantNoOrPattern,
     // Only a top-level un-parenthesized enum variant pattern can be ambiguous.
@@ -1081,6 +1081,7 @@ UOp: UnaryOp = {
     "label/go_codom" => UnaryOp::LabelGoCodom,
     "label/go_array" => UnaryOp::LabelGoArray,
     "label/go_dict" => UnaryOp::LabelGoDict,
+    "contract/from_predicate" => UnaryOp::ContractFromPredicate,
     "enum/embed" <Ident> => UnaryOp::EnumEmbed(<>),
     "array/map"  => UnaryOp::ArrayMap,
     "array/generate" => UnaryOp::ArrayGen,
@@ -1512,6 +1513,7 @@ extern {
         "contract/apply" => Token::Normal(NormalToken::ContractApply),
         "contract/array_lazy_app" => Token::Normal(NormalToken::ContractArrayLazyApp),
         "contract/record_lazy_app" => Token::Normal(NormalToken::ContractRecordLazyApp),
+        "contract/from_predicate" => Token::Normal(NormalToken::ContractFromPredicate),
         "op force" => Token::Normal(NormalToken::OpForce),
         "blame" => Token::Normal(NormalToken::Blame),
         "label/flip_polarity" => Token::Normal(NormalToken::LabelFlipPol),

core/src/parser/lexer.rs

@@ -200,6 +200,8 @@ pub enum NormalToken<'input> {
     ContractArrayLazyApp,
     #[token("%contract/record_lazy_apply%")]
     ContractRecordLazyApp,
+    #[token("%contract/from_predicate%")]
+    ContractFromPredicate,
     #[token("%blame%")]
     Blame,
     #[token("%label/flip_polarity%")]

core/src/pretty.rs

@@ -5,6 +5,9 @@ use crate::parser::lexer::KEYWORDS;
 use crate::term::{
     pattern::*,
     record::{Field, FieldMetadata, RecordData},
+    // Because we use `Term::*`, we need to differentiate `Contract` from `Term::Contract`, so we
+    // alias the latter
+    CustomContract as ContractNode,
     *,
 };
 use crate::typ::*;
@@ -139,6 +142,7 @@ fn needs_parens_in_type_pos(typ: &Type) -> bool {
             term.as_ref(),
             Term::Fun(..)
                 | Term::FunPattern(..)
+                | Term::CustomContract(CustomContract::Predicate(..))
                 | Term::Let(..)
                 | Term::LetPattern(..)
                 | Term::Op1(UnaryOp::IfThenElse, _)
@@ -251,6 +255,43 @@ where
             .enclose(start_delimiter, end_delimiter)
     }
 
+    /// Print a function, which can have several parameters (represented as nested functions), and
+    /// where each layer might be a normal function, a pattern matching function or a custom
+    /// contract. [function] automatically unwrap any of those nested layers to print the function
+    /// with as many parameters as possible on the left of the `=>` separator.
+    fn function(
+        &'a self,
+        first_param: impl Pretty<'a, Self, A>,
+        mut body: &RichTerm,
+    ) -> DocBuilder<'a, Self, A> {
+        let mut builder = docs![self, "fun", self.line(), first_param];
+
+        loop {
+            match body.as_ref() {
+                Term::Fun(id, rt) | Term::CustomContract(CustomContract::Predicate(id, rt)) => {
+                    builder = docs![self, builder, self.line(), self.as_string(id)];
+                    body = rt;
+                }
+                Term::FunPattern(pat, rt) => {
+                    builder = docs![self, builder, self.line(), self.pat_with_parens(pat)];
+                    body = rt;
+                }
+                _ => break,
+            }
+        }
+
+        docs![
+            self,
+            builder,
+            self.line(),
+            "=>",
+            self.line(),
+            body.pretty(self)
+        ]
+        .nest(2)
+        .group()
+    }
+
     fn field_metadata(
         &'a self,
         metadata: &FieldMetadata,
@@ -779,49 +820,20 @@ where
             Num(n) => allocator.as_string(format!("{}", n.to_sci())),
             Str(v) => allocator.escaped_string(v).double_quotes(),
             StrChunks(chunks) => allocator.chunks(chunks, StringRenderStyle::Multiline),
-            Fun(id, rt) => {
-                let mut params = vec![id];
-                let mut rt = rt;
-                while let Fun(id, t) = rt.as_ref() {
-                    params.push(id);
-                    rt = t
-                }
-                docs![
-                    allocator,
-                    "fun",
-                    allocator.line(),
-                    allocator.intersperse(
-                        params.iter().map(|p| allocator.as_string(p)),
-                        allocator.line()
-                    ),
-                    allocator.line(),
-                    "=>",
-                    allocator.line(),
-                    rt
-                ]
-                .nest(2)
-                .group()
-            }
-            FunPattern(..) => {
-                let mut params = vec![];
-                let mut rt = self;
-                while let FunPattern(pat, t) = rt {
-                    params.push(allocator.pat_with_parens(pat));
-                    rt = t.as_ref();
-                }
+            Fun(id, body) => allocator.function(allocator.as_string(id), body),
+            FunPattern(pat, body) => allocator.function(allocator.pat_with_parens(pat), body),
+            // Format this as the application `std.contract.from_predicate <pred>`.
+            CustomContract(ContractNode::Predicate(id, pred)) => docs![
+                allocator,
+                "%contract/from_predicate%",
                 docs![
                     allocator,
-                    "fun",
-                    allocator.line(),
-                    allocator.intersperse(params, allocator.line()),
                     allocator.line(),
-                    "=>",
-                    allocator.line(),
-                    rt
+                    allocator.function(allocator.as_string(id), pred).parens()
                 ]
                 .nest(2)
                 .group()
-            }
+            ],
             Lbl(_lbl) => allocator.text("%<label>").append(allocator.line()),
             Let(id, rt, body, attrs) => docs![
                 allocator,

core/src/stdlib.rs

@@ -102,6 +102,8 @@ pub mod internals {
 
     generate_accessor!(stdlib_contract_equal);
 
+    generate_accessor!(predicate_to_ctr);
+
     generate_accessor!(rec_default);
     generate_accessor!(rec_force);
 }

core/src/term/mod.rs

@@ -216,6 +216,21 @@ pub enum Term {
     #[serde(skip)]
     Type(Type),
 
+    /// A custom contract built using e.g. `std.contract.from_predicate`. Currently, custom
+    /// contracts can be partial identities (the most general form, which either blame or return
+    /// the value with potentital delayed checks burried inside) or a predicate. Ideally, both
+    /// would fall under then `CustomContract` node.
+    ///
+    /// For now, we only put predicates built using `std.contract.from_predicate` here.
+    ///
+    /// The reason for having a separate node (instead of encoding everything as partial identities
+    /// under a normal `Fun` node) is that we can leverage the metadata for example to implement a
+    /// restricted `or` combinator on contracts, which needs to know which contracts are built from
+    /// predicates, or for better error messages in the future when parametric contracts aren't
+    /// fully applied ([#1460](https://github.com/tweag/nickel/issues/1460)).
+    #[serde(skip)]
+    CustomContract(CustomContract),
+
     /// A term that couldn't be parsed properly. Used by the LSP to handle partially valid
     /// programs.
     #[serde(skip)]
@@ -361,13 +376,33 @@ pub enum BindingType {
     Revertible(FieldDeps),
 }
 
-/// A runtime representation of a contract, as a term ready to be applied via `AppContract`
-/// together with its label.
+/// A term representing a custom contract.
+///
+/// This term doesn't currently include generic custom contracts (functions `Label -> Dyn -> Dyn`)
+/// for backward compatibility reasons. In the future, we want to have all custom contracts
+/// represented as [CustomContract]s, requiring the use of a dedicated constructor:
+/// `std.contract.from_function`, `std.contract.from_record`, etc in user code. The requirement of
+/// this dedicated constructors is unfortunately a breaking change for existing custom contracts
+/// oftetn written as bare functions.
+///
+/// In the meantime, we can put _some_ contracts here without breaking things (the one that are
+/// already built using a special constructor, such as `std.contract.from_predicate`). Maintaining
+/// those additional data (if a contract came from `from_predicate` or is a bare function) is
+/// useful for implementing some contract operations, such as the `or` combinator, or provide
+/// better error messages in some situations.
+#[derive(Debug, Clone, Serialize, Deserialize)]
+pub enum CustomContract {
+    /// A contract built from a predicate. The argument is a function of type
+    /// `Dyn -> Bool`.
+    Predicate(LocIdent, RichTerm),
+}
+
+/// A runtime representation of a contract, as a term and a label ready to be applied via
+/// [BinaryOp::ContractApply].
 #[derive(Debug, PartialEq, Clone)]
 pub struct RuntimeContract {
-    /// The pending contract, can be a function or a record.
+    /// The pending contract, which can be a function, a type, a [CustomContract] or a record.
     pub contract: RichTerm,
-
     /// The blame label.
     pub label: Label,
 }
@@ -884,7 +919,11 @@ impl Term {
             Term::Bool(_) => Some("Bool".to_owned()),
             Term::Num(_) => Some("Number".to_owned()),
             Term::Str(_) => Some("String".to_owned()),
-            Term::Fun(_, _) | Term::FunPattern(_, _) => Some("Function".to_owned()),
+            Term::Fun(_, _)
+            | Term::FunPattern(_, _)
+            // We could print a separate type for predicates. For the time being, we just consider
+            // it to be the function resulting of `$predicate_to_ctr pred`.
+            | Term::CustomContract(CustomContract::Predicate(..)) => Some("Function".to_owned()),
             Term::Match { .. } => Some("MatchExpression".to_owned()),
             Term::Lbl(_) => Some("Label".to_owned()),
             Term::Enum(_) => Some("EnumTag".to_owned()),
@@ -936,6 +975,7 @@ impl Term {
             | Term::Fun(..)
             // match expressions are function
             | Term::Match {..}
+            | Term::CustomContract(CustomContract::Predicate(..))
             | Term::Lbl(_)
             | Term::Enum(_)
             | Term::EnumVariant {..}
@@ -1007,6 +1047,7 @@ impl Term {
             | Term::Array(..)
             | Term::Fun(..)
             | Term::FunPattern(..)
+            | Term::CustomContract(CustomContract::Predicate(..))
             | Term::App(_, _)
             | Term::Match { .. }
             | Term::Var(_)
@@ -1064,6 +1105,7 @@ impl Term {
             | Term::LetPattern(..)
             | Term::Fun(..)
             | Term::FunPattern(..)
+            | Term::CustomContract(CustomContract::Predicate(..))
             | Term::App(..)
             | Term::Op1(..)
             | Term::Op2(..)
@@ -1251,6 +1293,10 @@ pub enum UnaryOp {
     /// See `GoDom`.
     LabelGoDict,
 
+    /// Wrap a predicate function as a [CustomContract::Predicate]. You can think of this primop as
+    /// one type constructor for contracts.
+    ContractFromPredicate,
+
     /// Force the evaluation of its argument and proceed with the second.
     Seq,
 
@@ -1461,6 +1507,7 @@ impl fmt::Display for UnaryOp {
             LabelGoCodom => write!(f, "label/go_codom"),
             LabelGoArray => write!(f, "label/go_array"),
             LabelGoDict => write!(f, "label/go_dict"),
+            ContractFromPredicate => write!(f, "contract/from_predicate"),
             Seq => write!(f, "seq"),
             DeepSeq => write!(f, "deep_seq"),
             ArrayLength => write!(f, "array/length"),
@@ -2231,6 +2278,7 @@ impl Traverse<RichTerm> for RichTerm {
             }),
             Term::Fun(_, t)
             | Term::FunPattern(_, t)
+            | Term::CustomContract(CustomContract::Predicate(_, t))
             | Term::EnumVariant { arg: t, .. }
             | Term::Op1(_, t)
             | Term::Sealed(_, t, _) => t.traverse_ref(f, state),

core/src/transform/free_vars.rs

@@ -8,7 +8,7 @@ use crate::{
     term::pattern::*,
     term::{
         record::{Field, FieldDeps, RecordDeps},
-        IndexMap, MatchBranch, RichTerm, SharedTerm, StrChunk, Term,
+        CustomContract, IndexMap, MatchBranch, RichTerm, SharedTerm, StrChunk, Term,
     },
     typ::{RecordRowF, RecordRows, RecordRowsF, Type, TypeF},
 };
@@ -44,7 +44,7 @@ impl CollectFreeVars for RichTerm {
             | Term::Enum(_)
             | Term::Import(_)
             | Term::ResolvedImport(_) => (),
-            Term::Fun(id, t) => {
+            Term::Fun(id, t) | Term::CustomContract(CustomContract::Predicate(id, t)) => {
                 let mut fresh = HashSet::new();
 
                 t.collect_free_vars(&mut fresh);