diff options
Diffstat (limited to 'dhall/src/phase')
-rw-r--r-- | dhall/src/phase/mod.rs | 10 | ||||
-rw-r--r-- | dhall/src/phase/normalize.rs | 999 | ||||
-rw-r--r-- | dhall/src/phase/typecheck.rs | 345 |
3 files changed, 160 insertions, 1194 deletions
diff --git a/dhall/src/phase/mod.rs b/dhall/src/phase/mod.rs index 4262dc1..0faf6dd 100644 --- a/dhall/src/phase/mod.rs +++ b/dhall/src/phase/mod.rs @@ -4,11 +4,13 @@ use std::path::Path; use dhall_syntax::{Const, Import, Span, SubExpr, X}; +use crate::core::context::TypecheckContext; +use crate::core::thunk::Thunk; +use crate::core::value::{AlphaVar, Value}; use crate::error::{Error, ImportError, TypeError, TypeMessage}; -use normalize::{AlphaVar, Thunk, Value}; use resolve::ImportRoot; -use typecheck::{const_to_typed, type_of_const, TypecheckContext}; +use typecheck::{const_to_typed, type_of_const}; pub(crate) mod binary; pub(crate) mod normalize; @@ -305,6 +307,10 @@ impl Normalized { pub(crate) fn to_type(self) -> Type { self.0.to_type() } + pub(crate) fn get_type(&self) -> Result<Cow<'_, Type>, TypeError> { + self.0.get_type() + } + pub(crate) fn shift(&self, delta: isize, var: &AlphaVar) -> Self { Normalized(self.0.shift(delta, var)) } diff --git a/dhall/src/phase/normalize.rs b/dhall/src/phase/normalize.rs index 2340bbd..a48c299 100644 --- a/dhall/src/phase/normalize.rs +++ b/dhall/src/phase/normalize.rs @@ -1,988 +1,16 @@ -#![allow(non_snake_case)] use std::collections::BTreeMap; -use std::rc::Rc; -use dhall_proc_macros as dhall; -use dhall_syntax::context::Context; -use dhall_syntax::{ - rc, BinOp, Builtin, Const, ExprF, Integer, InterpolatedTextContents, Label, - Natural, V, X, -}; +use dhall_syntax::{BinOp, Builtin, ExprF, InterpolatedTextContents, Label, X}; -use crate::phase::{NormalizedSubExpr, ResolvedSubExpr, Type, Typed}; +use crate::core::context::NormalizationContext; +use crate::core::thunk::{Thunk, TypeThunk}; +use crate::core::value::Value; +use crate::phase::{NormalizedSubExpr, ResolvedSubExpr, Typed}; -type InputSubExpr = ResolvedSubExpr; -type OutputSubExpr = NormalizedSubExpr; +pub(crate) type InputSubExpr = ResolvedSubExpr; +pub(crate) type OutputSubExpr = NormalizedSubExpr; -/// Stores a pair of variables: a normal one and if relevant one -/// that corresponds to the alpha-normalized version of the first one. -#[derive(Debug, Clone, Eq)] -pub(crate) struct AlphaVar { - normal: V<Label>, - alpha: Option<V<()>>, -} - -impl AlphaVar { - pub(crate) fn to_var(&self, alpha: bool) -> V<Label> { - match (alpha, &self.alpha) { - (true, Some(x)) => V("_".into(), x.1), - _ => self.normal.clone(), - } - } - pub(crate) fn from_var(normal: V<Label>) -> Self { - AlphaVar { - normal, - alpha: None, - } - } - pub(crate) fn shift(&self, delta: isize, var: &AlphaVar) -> Self { - AlphaVar { - normal: self.normal.shift(delta, &var.normal), - alpha: match (&self.alpha, &var.alpha) { - (Some(x), Some(v)) => Some(x.shift(delta, v)), - _ => None, - }, - } - } -} - -/// Equality is up to alpha-equivalence. -impl std::cmp::PartialEq for AlphaVar { - fn eq(&self, other: &Self) -> bool { - match (&self.alpha, &other.alpha) { - (Some(x), Some(y)) => x == y, - (None, None) => self.normal == other.normal, - _ => false, - } - } -} - -impl From<Label> for AlphaVar { - fn from(x: Label) -> AlphaVar { - AlphaVar { - normal: V(x, 0), - alpha: Some(V((), 0)), - } - } -} -impl<'a> From<&'a Label> for AlphaVar { - fn from(x: &'a Label) -> AlphaVar { - x.clone().into() - } -} -impl From<AlphaLabel> for AlphaVar { - fn from(x: AlphaLabel) -> AlphaVar { - let l: Label = x.into(); - l.into() - } -} -impl<'a> From<&'a AlphaLabel> for AlphaVar { - fn from(x: &'a AlphaLabel) -> AlphaVar { - x.clone().into() - } -} - -// Exactly like a Label, but equality returns always true. -// This is so that Value equality is exactly alpha-equivalence. -#[derive(Debug, Clone, Eq)] -pub(crate) struct AlphaLabel(Label); - -impl AlphaLabel { - fn to_label_maybe_alpha(&self, alpha: bool) -> Label { - if alpha { - "_".into() - } else { - self.to_label() - } - } - fn to_label(&self) -> Label { - self.clone().into() - } -} - -impl std::cmp::PartialEq for AlphaLabel { - fn eq(&self, _other: &Self) -> bool { - true - } -} - -impl From<Label> for AlphaLabel { - fn from(x: Label) -> AlphaLabel { - AlphaLabel(x) - } -} -impl From<AlphaLabel> for Label { - fn from(x: AlphaLabel) -> Label { - x.0 - } -} - -#[derive(Debug, Clone)] -enum EnvItem { - Thunk(Thunk), - Skip(AlphaVar), -} - -impl EnvItem { - fn shift(&self, delta: isize, var: &AlphaVar) -> Self { - use EnvItem::*; - match self { - Thunk(e) => Thunk(e.shift(delta, var)), - Skip(v) => Skip(v.shift(delta, var)), - } - } - - pub(crate) fn subst_shift(&self, var: &AlphaVar, val: &Typed) -> Self { - match self { - EnvItem::Thunk(e) => EnvItem::Thunk(e.subst_shift(var, val)), - EnvItem::Skip(v) if v == var => EnvItem::Thunk(val.to_thunk()), - EnvItem::Skip(v) => EnvItem::Skip(v.shift(-1, var)), - } - } -} - -#[derive(Debug, Clone)] -pub(crate) struct NormalizationContext(Rc<Context<Label, EnvItem>>); - -impl NormalizationContext { - pub(crate) fn new() -> Self { - NormalizationContext(Rc::new(Context::new())) - } - fn skip(&self, x: &Label) -> Self { - NormalizationContext(Rc::new( - self.0 - .map(|_, e| e.shift(1, &x.into())) - .insert(x.clone(), EnvItem::Skip(x.into())), - )) - } - fn lookup(&self, var: &V<Label>) -> Value { - let V(x, n) = var; - match self.0.lookup(x, *n) { - Some(EnvItem::Thunk(t)) => t.to_value(), - Some(EnvItem::Skip(newvar)) => Value::Var(newvar.clone()), - // Free variable - None => Value::Var(AlphaVar::from_var(var.clone())), - } - } - pub(crate) fn from_typecheck_ctx( - tc_ctx: &crate::phase::typecheck::TypecheckContext, - ) -> Self { - use crate::phase::typecheck::EnvItem::*; - let mut ctx = Context::new(); - for (k, vs) in tc_ctx.0.iter_keys() { - for v in vs.iter() { - let new_item = match v { - Type(var, _) => EnvItem::Skip(var.clone()), - Value(e) => EnvItem::Thunk(e.to_thunk()), - }; - ctx = ctx.insert(k.clone(), new_item); - } - } - NormalizationContext(Rc::new(ctx)) - } - - fn shift(&self, delta: isize, var: &AlphaVar) -> Self { - NormalizationContext(Rc::new(self.0.map(|_, e| e.shift(delta, var)))) - } - - fn subst_shift(&self, var: &AlphaVar, val: &Typed) -> Self { - NormalizationContext(Rc::new( - self.0.map(|_, e| e.subst_shift(var, val)), - )) - } -} - -/// A semantic value. -/// Equality is up to alpha-equivalence (renaming of bound variables). -#[derive(Debug, Clone, PartialEq, Eq)] -pub(crate) enum Value { - /// Closures - Lam(AlphaLabel, Thunk, Thunk), - AppliedBuiltin(Builtin, Vec<Thunk>), - /// `λ(x: a) -> Some x` - OptionalSomeClosure(TypeThunk), - /// `λ(x : a) -> λ(xs : List a) -> [ x ] # xs` - /// `λ(xs : List a) -> [ x ] # xs` - ListConsClosure(TypeThunk, Option<Thunk>), - /// `λ(x : Natural) -> x + 1` - NaturalSuccClosure, - Pi(AlphaLabel, TypeThunk, TypeThunk), - - Var(AlphaVar), - Const(Const), - BoolLit(bool), - NaturalLit(Natural), - IntegerLit(Integer), - EmptyOptionalLit(TypeThunk), - NEOptionalLit(Thunk), - EmptyListLit(TypeThunk), - NEListLit(Vec<Thunk>), - RecordLit(BTreeMap<Label, Thunk>), - RecordType(BTreeMap<Label, TypeThunk>), - UnionType(BTreeMap<Label, Option<TypeThunk>>), - UnionConstructor(Label, BTreeMap<Label, Option<TypeThunk>>), - UnionLit(Label, Thunk, BTreeMap<Label, Option<TypeThunk>>), - TextLit(Vec<InterpolatedTextContents<Thunk>>), - /// Invariant: This must not contain a value captured by one of the variants above. - PartialExpr(ExprF<Thunk, Label, X>), -} - -impl Value { - pub(crate) fn into_thunk(self) -> Thunk { - Thunk::from_value(self) - } - - /// Convert the value to a fully normalized syntactic expression - pub(crate) fn normalize_to_expr(&self) -> OutputSubExpr { - self.normalize_to_expr_maybe_alpha(false) - } - /// Convert the value to a fully normalized syntactic expression. Also alpha-normalize - /// if alpha is `true` - pub(crate) fn normalize_to_expr_maybe_alpha( - &self, - alpha: bool, - ) -> OutputSubExpr { - match self { - Value::Lam(x, t, e) => rc(ExprF::Lam( - x.to_label_maybe_alpha(alpha), - t.normalize_to_expr_maybe_alpha(alpha), - e.normalize_to_expr_maybe_alpha(alpha), - )), - Value::AppliedBuiltin(b, args) => { - let mut e = rc(ExprF::Builtin(*b)); - for v in args { - e = rc(ExprF::App( - e, - v.normalize_to_expr_maybe_alpha(alpha), - )); - } - e - } - Value::OptionalSomeClosure(n) => { - let a = n.normalize_to_expr_maybe_alpha(alpha); - dhall::subexpr!(λ(x: a) -> Some x) - } - Value::ListConsClosure(a, None) => { - // Avoid accidental capture of the new `x` variable - let a1 = a.shift(1, &Label::from("x").into()); - let a1 = a1.normalize_to_expr_maybe_alpha(alpha); - let a = a.normalize_to_expr_maybe_alpha(alpha); - dhall::subexpr!(λ(x : a) -> λ(xs : List a1) -> [ x ] # xs) - } - Value::ListConsClosure(n, Some(v)) => { - // Avoid accidental capture of the new `xs` variable - let v = v.shift(1, &Label::from("xs").into()); - let v = v.normalize_to_expr_maybe_alpha(alpha); - let a = n.normalize_to_expr_maybe_alpha(alpha); - dhall::subexpr!(λ(xs : List a) -> [ v ] # xs) - } - Value::NaturalSuccClosure => { - dhall::subexpr!(λ(x : Natural) -> x + 1) - } - Value::Pi(x, t, e) => rc(ExprF::Pi( - x.to_label_maybe_alpha(alpha), - t.normalize_to_expr_maybe_alpha(alpha), - e.normalize_to_expr_maybe_alpha(alpha), - )), - Value::Var(v) => rc(ExprF::Var(v.to_var(alpha))), - Value::Const(c) => rc(ExprF::Const(*c)), - Value::BoolLit(b) => rc(ExprF::BoolLit(*b)), - Value::NaturalLit(n) => rc(ExprF::NaturalLit(*n)), - Value::IntegerLit(n) => rc(ExprF::IntegerLit(*n)), - Value::EmptyOptionalLit(n) => rc(ExprF::App( - rc(ExprF::Builtin(Builtin::OptionalNone)), - n.normalize_to_expr_maybe_alpha(alpha), - )), - Value::NEOptionalLit(n) => { - rc(ExprF::SomeLit(n.normalize_to_expr_maybe_alpha(alpha))) - } - Value::EmptyListLit(n) => { - rc(ExprF::EmptyListLit(n.normalize_to_expr_maybe_alpha(alpha))) - } - Value::NEListLit(elts) => rc(ExprF::NEListLit( - elts.into_iter() - .map(|n| n.normalize_to_expr_maybe_alpha(alpha)) - .collect(), - )), - Value::RecordLit(kvs) => rc(ExprF::RecordLit( - kvs.iter() - .map(|(k, v)| { - (k.clone(), v.normalize_to_expr_maybe_alpha(alpha)) - }) - .collect(), - )), - Value::RecordType(kts) => rc(ExprF::RecordType( - kts.iter() - .map(|(k, v)| { - (k.clone(), v.normalize_to_expr_maybe_alpha(alpha)) - }) - .collect(), - )), - Value::UnionType(kts) => rc(ExprF::UnionType( - kts.iter() - .map(|(k, v)| { - ( - k.clone(), - v.as_ref().map(|v| { - v.normalize_to_expr_maybe_alpha(alpha) - }), - ) - }) - .collect(), - )), - Value::UnionConstructor(l, kts) => { - let kts = kts - .iter() - .map(|(k, v)| { - ( - k.clone(), - v.as_ref().map(|v| { - v.normalize_to_expr_maybe_alpha(alpha) - }), - ) - }) - .collect(); - rc(ExprF::Field(rc(ExprF::UnionType(kts)), l.clone())) - } - Value::UnionLit(l, v, kts) => rc(ExprF::UnionLit( - l.clone(), - v.normalize_to_expr_maybe_alpha(alpha), - kts.iter() - .map(|(k, v)| { - ( - k.clone(), - v.as_ref().map(|v| { - v.normalize_to_expr_maybe_alpha(alpha) - }), - ) - }) - .collect(), - )), - Value::TextLit(elts) => { - use InterpolatedTextContents::{Expr, Text}; - rc(ExprF::TextLit( - elts.iter() - .map(|contents| match contents { - Expr(e) => { - Expr(e.normalize_to_expr_maybe_alpha(alpha)) - } - Text(s) => Text(s.clone()), - }) - .collect(), - )) - } - Value::PartialExpr(e) => { - rc(e.map_ref_simple(|v| v.normalize_to_expr_maybe_alpha(alpha))) - } - } - } - - // Deprecated - fn normalize(&self) -> Value { - let mut v = self.clone(); - v.normalize_mut(); - v - } - - pub(crate) fn normalize_mut(&mut self) { - match self { - Value::NaturalSuccClosure - | Value::Var(_) - | Value::Const(_) - | Value::BoolLit(_) - | Value::NaturalLit(_) - | Value::IntegerLit(_) => {} - - Value::EmptyOptionalLit(tth) - | Value::OptionalSomeClosure(tth) - | Value::EmptyListLit(tth) => { - tth.normalize_mut(); - } - - Value::NEOptionalLit(th) => { - th.normalize_mut(); - } - Value::Lam(_, t, e) => { - t.normalize_mut(); - e.normalize_mut(); - } - Value::Pi(_, t, e) => { - t.normalize_mut(); - e.normalize_mut(); - } - Value::AppliedBuiltin(_, args) => { - for x in args.iter_mut() { - x.normalize_mut(); - } - } - Value::ListConsClosure(t, v) => { - t.normalize_mut(); - for x in v.iter_mut() { - x.normalize_mut(); - } - } - Value::NEListLit(elts) => { - for x in elts.iter_mut() { - x.normalize_mut(); - } - } - Value::RecordLit(kvs) => { - for x in kvs.values_mut() { - x.normalize_mut(); - } - } - Value::RecordType(kvs) => { - for x in kvs.values_mut() { - x.normalize_mut(); - } - } - Value::UnionType(kts) | Value::UnionConstructor(_, kts) => { - for x in kts.values_mut().flat_map(|opt| opt) { - x.normalize_mut(); - } - } - Value::UnionLit(_, v, kts) => { - v.normalize_mut(); - for x in kts.values_mut().flat_map(|opt| opt) { - x.normalize_mut(); - } - } - Value::TextLit(elts) => { - for x in elts.iter_mut() { - use InterpolatedTextContents::{Expr, Text}; - match x { - Expr(n) => n.normalize_mut(), - Text(_) => {} - } - } - } - Value::PartialExpr(e) => { - // TODO: need map_mut_simple - e.map_ref_simple(|v| { - v.normalize_nf(); - }); - } - } - } - - /// Apply to a value - pub(crate) fn app(self, val: Value) -> Value { - self.app_val(val) - } - - /// Apply to a value - pub(crate) fn app_val(self, val: Value) -> Value { - self.app_thunk(val.into_thunk()) - } - - /// Apply to a thunk - pub(crate) fn app_thunk(self, th: Thunk) -> Value { - Thunk::from_value(self).app_thunk(th) - } - - pub(crate) fn from_builtin(b: Builtin) -> Value { - Value::AppliedBuiltin(b, vec![]) - } - - fn shift(&self, delta: isize, var: &AlphaVar) -> Self { - match self { - Value::Lam(x, t, e) => Value::Lam( - x.clone(), - t.shift(delta, var), - e.shift(delta, &var.shift(1, &x.into())), - ), - Value::AppliedBuiltin(b, args) => Value::AppliedBuiltin( - *b, - args.iter().map(|v| v.shift(delta, var)).collect(), - ), - Value::NaturalSuccClosure => Value::NaturalSuccClosure, - Value::OptionalSomeClosure(tth) => { - Value::OptionalSomeClosure(tth.shift(delta, var)) - } - Value::ListConsClosure(t, v) => Value::ListConsClosure( - t.shift(delta, var), - v.as_ref().map(|v| v.shift(delta, var)), - ), - Value::Pi(x, t, e) => Value::Pi( - x.clone(), - t.shift(delta, var), - e.shift(delta, &var.shift(1, &x.into())), - ), - Value::Var(v) => Value::Var(v.shift(delta, var)), - Value::Const(c) => Value::Const(*c), - Value::BoolLit(b) => Value::BoolLit(*b), - Value::NaturalLit(n) => Value::NaturalLit(*n), - Value::IntegerLit(n) => Value::IntegerLit(*n), - Value::EmptyOptionalLit(tth) => { - Value::EmptyOptionalLit(tth.shift(delta, var)) - } - Value::NEOptionalLit(th) => { - Value::NEOptionalLit(th.shift(delta, var)) - } - Value::EmptyListLit(tth) => { - Value::EmptyListLit(tth.shift(delta, var)) - } - Value::NEListLit(elts) => Value::NEListLit( - elts.iter().map(|v| v.shift(delta, var)).collect(), - ), - Value::RecordLit(kvs) => Value::RecordLit( - kvs.iter() - .map(|(k, v)| (k.clone(), v.shift(delta, var))) - .collect(), - ), - Value::RecordType(kvs) => Value::RecordType( - kvs.iter() - .map(|(k, v)| (k.clone(), v.shift(delta, var))) - .collect(), - ), - Value::UnionType(kts) => Value::UnionType( - kts.iter() - .map(|(k, v)| { - (k.clone(), v.as_ref().map(|v| v.shift(delta, var))) - }) - .collect(), - ), - Value::UnionConstructor(x, kts) => Value::UnionConstructor( - x.clone(), - kts.iter() - .map(|(k, v)| { - (k.clone(), v.as_ref().map(|v| v.shift(delta, var))) - }) - .collect(), - ), - Value::UnionLit(x, v, kts) => Value::UnionLit( - x.clone(), - v.shift(delta, var), - kts.iter() - .map(|(k, v)| { - (k.clone(), v.as_ref().map(|v| v.shift(delta, var))) - }) - .collect(), - ), - Value::TextLit(elts) => Value::TextLit( - elts.iter() - .map(|contents| { - use InterpolatedTextContents::{Expr, Text}; - match contents { - Expr(th) => Expr(th.shift(delta, var)), - Text(s) => Text(s.clone()), - } - }) - .collect(), - ), - Value::PartialExpr(e) => { - Value::PartialExpr(e.map_ref_with_special_handling_of_binders( - |v| v.shift(delta, var), - |x, v| v.shift(delta, &var.shift(1, &x.into())), - X::clone, - Label::clone, - )) - } - } - } - - pub(crate) fn subst_shift(&self, var: &AlphaVar, val: &Typed) -> Self { - match self { - // Retry normalizing since substituting may allow progress - Value::AppliedBuiltin(b, args) => apply_builtin( - *b, - args.iter().map(|v| v.subst_shift(var, val)).collect(), - ), - // Retry normalizing since substituting may allow progress - Value::PartialExpr(e) => { - normalize_one_layer(e.map_ref_with_special_handling_of_binders( - |v| v.subst_shift(var, val), - |x, v| { - v.subst_shift( - &var.shift(1, &x.into()), - &val.shift(1, &x.into()), - ) - }, - X::clone, - Label::clone, - )) - } - // Retry normalizing since substituting may allow progress - Value::TextLit(elts) => { - Value::TextLit(squash_textlit(elts.iter().map(|contents| { - use InterpolatedTextContents::{Expr, Text}; - match contents { - Expr(th) => Expr(th.subst_shift(var, val)), - Text(s) => Text(s.clone()), - } - }))) - } - Value::Lam(x, t, e) => Value::Lam( - x.clone(), - t.subst_shift(var, val), - e.subst_shift( - &var.shift(1, &x.into()), - &val.shift(1, &x.into()), - ), - ), - Value::NaturalSuccClosure => Value::NaturalSuccClosure, - Value::OptionalSomeClosure(tth) => { - Value::OptionalSomeClosure(tth.subst_shift(var, val)) - } - Value::ListConsClosure(t, v) => Value::ListConsClosure( - t.subst_shift(var, val), - v.as_ref().map(|v| v.subst_shift(var, val)), - ), - Value::Pi(x, t, e) => Value::Pi( - x.clone(), - t.subst_shift(var, val), - e.subst_shift( - &var.shift(1, &x.into()), - &val.shift(1, &x.into()), - ), - ), - Value::Var(v) if v == var => val.to_value().clone(), - Value::Var(v) => Value::Var(v.shift(-1, var)), - Value::Const(c) => Value::Const(*c), - Value::BoolLit(b) => Value::BoolLit(*b), - Value::NaturalLit(n) => Value::NaturalLit(*n), - Value::IntegerLit(n) => Value::IntegerLit(*n), - Value::EmptyOptionalLit(tth) => { - Value::EmptyOptionalLit(tth.subst_shift(var, val)) - } - Value::NEOptionalLit(th) => { - Value::NEOptionalLit(th.subst_shift(var, val)) - } - Value::EmptyListLit(tth) => { - Value::EmptyListLit(tth.subst_shift(var, val)) - } - Value::NEListLit(elts) => Value::NEListLit( - elts.iter().map(|v| v.subst_shift(var, val)).collect(), - ), - Value::RecordLit(kvs) => Value::RecordLit( - kvs.iter() - .map(|(k, v)| (k.clone(), v.subst_shift(var, val))) - .collect(), - ), - Value::RecordType(kvs) => Value::RecordType( - kvs.iter() - .map(|(k, v)| (k.clone(), v.subst_shift(var, val))) - .collect(), - ), - Value::UnionType(kts) => Value::UnionType( - kts.iter() - .map(|(k, v)| { - (k.clone(), v.as_ref().map(|v| v.subst_shift(var, val))) - }) - .collect(), - ), - Value::UnionConstructor(x, kts) => Value::UnionConstructor( - x.clone(), - kts.iter() - .map(|(k, v)| { - (k.clone(), v.as_ref().map(|v| v.subst_shift(var, val))) - }) - .collect(), - ), - Value::UnionLit(x, v, kts) => Value::UnionLit( - x.clone(), - v.subst_shift(var, val), - kts.iter() - .map(|(k, v)| { - (k.clone(), v.as_ref().map(|v| v.subst_shift(var, val))) - }) - .collect(), - ), - } - } -} - -mod thunk { - use super::{ - apply_any, normalize_whnf, AlphaVar, InputSubExpr, - NormalizationContext, OutputSubExpr, Value, - }; - use crate::phase::Typed; - use std::cell::{Ref, RefCell}; - use std::rc::Rc; - - #[derive(Debug, Clone, Copy)] - enum Marker { - /// Weak Head Normal Form, i.e. subexpressions may not be normalized - WHNF, - /// Normal form, i.e. completely normalized - NF, - } - use Marker::{NF, WHNF}; - - #[derive(Debug)] - enum ThunkInternal { - /// Non-normalized value alongside a normalization context - Unnormalized(NormalizationContext, InputSubExpr), - /// Partially normalized value. - /// Invariant: if the marker is `NF`, the value must be fully normalized - Value(Marker, Value), - } - - /// Stores a possibl unevaluated value. Uses RefCell to ensure that - /// the value gets normalized at most once. - #[derive(Debug, Clone)] - pub struct Thunk(Rc<RefCell<ThunkInternal>>); - - impl ThunkInternal { - fn into_thunk(self) -> Thunk { - Thunk(Rc::new(RefCell::new(self))) - } - - fn normalize_whnf(&mut self) { - match self { - ThunkInternal::Unnormalized(ctx, e) => { - *self = ThunkInternal::Value( - WHNF, - normalize_whnf(ctx.clone(), e.clone()), - ) - } - // Already at least in WHNF - ThunkInternal::Value(_, _) => {} - } - } - - fn normalize_nf(&mut self) { - match self { - ThunkInternal::Unnormalized(_, _) => { - self.normalize_whnf(); - self.normalize_nf(); - } - ThunkInternal::Value(m @ WHNF, v) => { - v.normalize_mut(); - *m = NF; - } - // Already in NF - ThunkInternal::Value(NF, _) => {} - } - } - - // Always use normalize_whnf before - fn as_whnf(&self) -> &Value { - match self { - ThunkInternal::Unnormalized(_, _) => unreachable!(), - ThunkInternal::Value(_, v) => v, - } - } - - // Always use normalize_nf before - fn as_nf(&self) -> &Value { - match self { - ThunkInternal::Unnormalized(_, _) => unreachable!(), - ThunkInternal::Value(WHNF, _) => unreachable!(), - ThunkInternal::Value(NF, v) => v, - } - } - - fn shift(&self, delta: isize, var: &AlphaVar) -> Self { - match self { - ThunkInternal::Unnormalized(ctx, e) => { - ThunkInternal::Unnormalized( - ctx.shift(delta, var), - e.clone(), - ) - } - ThunkInternal::Value(m, v) => { - ThunkInternal::Value(*m, v.shift(delta, var)) - } - } - } - - fn subst_shift(&self, var: &AlphaVar, val: &Typed) -> Self { - match self { - ThunkInternal::Unnormalized(ctx, e) => { - ThunkInternal::Unnormalized( - ctx.subst_shift(var, val), - e.clone(), - ) - } - ThunkInternal::Value(_, v) => { - // The resulting value may not stay in normal form after substitution - ThunkInternal::Value(WHNF, v.subst_shift(var, val)) - } - } - } - } - - impl Thunk { - pub(crate) fn new(ctx: NormalizationContext, e: InputSubExpr) -> Thunk { - ThunkInternal::Unnormalized(ctx, e).into_thunk() - } - - pub(crate) fn from_value(v: Value) -> Thunk { - ThunkInternal::Value(WHNF, v).into_thunk() - } - - pub(crate) fn from_normalized_expr(e: OutputSubExpr) -> Thunk { - Thunk::new( - NormalizationContext::new(), - e.embed_absurd().note_absurd(), - ) - } - - // Normalizes contents to normal form; faster than `normalize_nf` if - // no one else shares this thunk - pub(crate) fn normalize_mut(&mut self) { - match Rc::get_mut(&mut self.0) { - // Mutate directly if sole owner - Some(refcell) => RefCell::get_mut(refcell).normalize_nf(), - // Otherwise mutate through the refcell - None => self.0.borrow_mut().normalize_nf(), - } - } - - fn do_normalize_whnf(&self) { - let borrow = self.0.borrow(); - match &*borrow { - ThunkInternal::Unnormalized(_, _) => { - drop(borrow); - self.0.borrow_mut().normalize_whnf(); - } - // Already at least in WHNF - ThunkInternal::Value(_, _) => {} - } - } - - fn do_normalize_nf(&self) { - let borrow = self.0.borrow(); - match &*borrow { - ThunkInternal::Unnormalized(_, _) - | ThunkInternal::Value(WHNF, _) => { - drop(borrow); - self.0.borrow_mut().normalize_nf(); - } - // Already in NF - ThunkInternal::Value(NF, _) => {} - } - } - - // WARNING: avoid normalizing any thunk while holding on to this ref - // or you could run into BorrowMut panics - pub(crate) fn normalize_nf(&self) -> Ref<Value> { - self.do_normalize_nf(); - Ref::map(self.0.borrow(), ThunkInternal::as_nf) - } - - // WARNING: avoid normalizing any thunk while holding on to this ref - // or you could run into BorrowMut panics - pub(crate) fn as_value(&self) -> Ref<Value> { - self.do_normalize_whnf(); - Ref::map(self.0.borrow(), ThunkInternal::as_whnf) - } - - pub(crate) fn to_value(&self) -> Value { - self.as_value().clone() - } - - pub(crate) fn normalize_to_expr(&self) -> OutputSubExpr { - self.normalize_to_expr_maybe_alpha(false) - } - - pub(crate) fn normalize_to_expr_maybe_alpha( - &self, - alpha: bool, - ) -> OutputSubExpr { - self.normalize_nf().normalize_to_expr_maybe_alpha(alpha) - } - - pub(crate) fn app_val(&self, val: Value) -> Value { - self.app_thunk(val.into_thunk()) - } - - pub(crate) fn app_thunk(&self, th: Thunk) -> Value { - apply_any(self.clone(), th) - } - - pub(crate) fn shift(&self, delta: isize, var: &AlphaVar) -> Self { - self.0.borrow().shift(delta, var).into_thunk() - } - - pub(crate) fn subst_shift(&self, var: &AlphaVar, val: &Typed) -> Self { - self.0.borrow().subst_shift(var, val).into_thunk() - } - } - - impl std::cmp::PartialEq for Thunk { - fn eq(&self, other: &Self) -> bool { - &*self.as_value() == &*other.as_value() - } - } - impl std::cmp::Eq for Thunk {} -} - -pub(crate) use thunk::Thunk; - -/// A thunk in type position. -#[derive(Debug, Clone)] -pub(crate) enum TypeThunk { - Thunk(Thunk), - Type(Type), -} - -impl TypeThunk { - fn from_value(v: Value) -> TypeThunk { - TypeThunk::from_thunk(Thunk::from_value(v)) - } - - fn from_thunk(th: Thunk) -> TypeThunk { - TypeThunk::Thunk(th) - } - - pub(crate) fn from_type(t: Type) -> TypeThunk { - TypeThunk::Type(t) - } - - fn normalize_mut(&mut self) { - match self { - TypeThunk::Thunk(th) => th.normalize_mut(), - TypeThunk::Type(_) => {} - } - } - - pub(crate) fn normalize_nf(&self) -> Value { - match self { - TypeThunk::Thunk(th) => th.normalize_nf().clone(), - TypeThunk::Type(t) => t.to_value().normalize(), - } - } - - pub(crate) fn to_value(&self) -> Value { - match self { - TypeThunk::Thunk(th) => th.to_value(), - TypeThunk::Type(t) => t.to_value(), - } - } - - pub(crate) fn normalize_to_expr_maybe_alpha( - &self, - alpha: bool, - ) -> OutputSubExpr { - self.normalize_nf().normalize_to_expr_maybe_alpha(alpha) - } - - fn shift(&self, delta: isize, var: &AlphaVar) -> Self { - match self { - TypeThunk::Thunk(th) => TypeThunk::Thunk(th.shift(delta, var)), - TypeThunk::Type(t) => TypeThunk::Type(t.shift(delta, var)), - } - } - - pub(crate) fn subst_shift(&self, var: &AlphaVar, val: &Typed) -> Self { - match self { - TypeThunk::Thunk(th) => TypeThunk::Thunk(th.subst_shift(var, val)), - TypeThunk::Type(t) => TypeThunk::Type(t.subst_shift(var, val)), - } - } -} - -impl std::cmp::PartialEq for TypeThunk { - fn eq(&self, other: &Self) -> bool { - self.to_value() == other.to_value() - } -} -impl std::cmp::Eq for TypeThunk {} - -fn apply_builtin(b: Builtin, args: Vec<Thunk>) -> Value { +pub(crate) fn apply_builtin(b: Builtin, args: Vec<Thunk>) -> Value { use dhall_syntax::Builtin::*; use Value::*; @@ -1170,7 +198,7 @@ fn apply_builtin(b: Builtin, args: Vec<Thunk>) -> Value { } } -fn apply_any(f: Thunk, a: Thunk) -> Value { +pub(crate) fn apply_any(f: Thunk, a: Thunk) -> Value { let fallback = |f: Thunk, a: Thunk| Value::PartialExpr(ExprF::App(f, a)); let f_borrow = f.as_value(); @@ -1226,7 +254,7 @@ fn apply_any(f: Thunk, a: Thunk) -> Value { } } -fn squash_textlit( +pub(crate) fn squash_textlit( elts: impl Iterator<Item = InterpolatedTextContents<Thunk>>, ) -> Vec<InterpolatedTextContents<Thunk>> { use std::mem::replace; @@ -1269,7 +297,10 @@ fn squash_textlit( } /// Reduces the imput expression to a Value. Evaluates as little as possible. -fn normalize_whnf(ctx: NormalizationContext, expr: InputSubExpr) -> Value { +pub(crate) fn normalize_whnf( + ctx: NormalizationContext, + expr: InputSubExpr, +) -> Value { match expr.as_ref() { ExprF::Embed(e) => return e.to_value(), ExprF::Var(v) => return ctx.lookup(v), @@ -1288,7 +319,7 @@ fn normalize_whnf(ctx: NormalizationContext, expr: InputSubExpr) -> Value { normalize_one_layer(expr) } -fn normalize_one_layer(expr: ExprF<Thunk, Label, X>) -> Value { +pub(crate) fn normalize_one_layer(expr: ExprF<Thunk, Label, X>) -> Value { use Value::{ BoolLit, EmptyListLit, EmptyOptionalLit, IntegerLit, Lam, NEListLit, NEOptionalLit, NaturalLit, Pi, RecordLit, RecordType, TextLit, diff --git a/dhall/src/phase/typecheck.rs b/dhall/src/phase/typecheck.rs index aee9892..42a4540 100644 --- a/dhall/src/phase/typecheck.rs +++ b/dhall/src/phase/typecheck.rs @@ -1,220 +1,18 @@ #![allow(non_snake_case)] use std::borrow::Borrow; -use std::borrow::Cow; use std::collections::BTreeMap; use dhall_proc_macros as dhall; -use dhall_syntax::context::Context; use dhall_syntax::{ rc, Builtin, Const, Expr, ExprF, InterpolatedTextContents, Label, Span, - SubExpr, V, X, + SubExpr, X, }; +use crate::core::context::{NormalizationContext, TypecheckContext}; +use crate::core::thunk::{Thunk, TypeThunk}; +use crate::core::value::Value; use crate::error::{TypeError, TypeMessage}; -use crate::phase::normalize::{ - AlphaVar, NormalizationContext, Thunk, TypeThunk, Value, -}; use crate::phase::{Normalized, Resolved, Type, TypeInternal, Typed}; -use crate::traits::DynamicType; - -impl TypeThunk { - fn to_type(&self, ctx: &TypecheckContext) -> Result<Type, TypeError> { - match self { - TypeThunk::Type(t) => Ok(t.clone()), - TypeThunk::Thunk(th) => { - // TODO: rule out statically - mktype(ctx, th.normalize_to_expr().embed_absurd().note_absurd()) - } - } - } -} - -#[derive(Debug, Clone)] -pub(crate) enum EnvItem { - Type(AlphaVar, Type), - Value(Normalized), -} - -impl EnvItem { - fn shift(&self, delta: isize, var: &AlphaVar) -> Self { - use EnvItem::*; - match self { - Type(v, e) => Type(v.shift(delta, var), e.shift(delta, var)), - Value(e) => Value(e.shift(delta, var)), - } - } -} - -#[derive(Debug, Clone)] -pub(crate) struct TypecheckContext(pub(crate) Context<Label, EnvItem>); - -impl TypecheckContext { - pub(crate) fn new() -> Self { - TypecheckContext(Context::new()) - } - pub(crate) fn insert_type(&self, x: &Label, t: Type) -> Self { - TypecheckContext( - self.0.map(|_, e| e.shift(1, &x.into())).insert( - x.clone(), - EnvItem::Type(x.into(), t.shift(1, &x.into())), - ), - ) - } - pub(crate) fn insert_value(&self, x: &Label, t: Normalized) -> Self { - TypecheckContext(self.0.insert(x.clone(), EnvItem::Value(t))) - } - pub(crate) fn lookup(&self, var: &V<Label>) -> Option<Cow<'_, Type>> { - let V(x, n) = var; - match self.0.lookup(x, *n) { - Some(EnvItem::Type(_, t)) => Some(Cow::Borrowed(&t)), - Some(EnvItem::Value(t)) => Some(t.get_type()?), - None => None, - } - } - fn to_normalization_ctx(&self) -> NormalizationContext { - NormalizationContext::from_typecheck_ctx(self) - } -} - -impl PartialEq for TypecheckContext { - fn eq(&self, _: &Self) -> bool { - // don't count contexts when comparing stuff - // this is dirty but needed for now - true - } -} -impl Eq for TypecheckContext {} - -fn function_check(a: Const, b: Const) -> Result<Const, ()> { - use dhall_syntax::Const::*; - match (a, b) { - (_, Type) => Ok(Type), - (Kind, Kind) => Ok(Kind), - (Sort, Sort) => Ok(Sort), - (Sort, Kind) => Ok(Sort), - _ => Err(()), - } -} - -// Equality up to alpha-equivalence (renaming of bound variables) -fn prop_equal<T, U>(eL0: T, eR0: U) -> bool -where - T: Borrow<Type>, - U: Borrow<Type>, -{ - eL0.borrow().to_value() == eR0.borrow().to_value() -} - -pub(crate) fn const_to_typed(c: Const) -> Typed { - match c { - Const::Sort => Typed::const_sort(), - _ => Typed::from_thunk_and_type( - Value::Const(c).into_thunk(), - type_of_const(c).unwrap(), - ), - } -} - -fn const_to_type(c: Const) -> Type { - Type(TypeInternal::Const(c)) -} - -pub(crate) fn type_of_const(c: Const) -> Result<Type, TypeError> { - match c { - Const::Type => Ok(Type::const_kind()), - Const::Kind => Ok(Type::const_sort()), - Const::Sort => { - return Err(TypeError::new( - &TypecheckContext::new(), - TypeMessage::Sort, - )) - } - } -} - -fn type_of_builtin<E>(b: Builtin) -> Expr<X, E> { - use dhall_syntax::Builtin::*; - match b { - Bool | Natural | Integer | Double | Text => dhall::expr!(Type), - List | Optional => dhall::expr!( - Type -> Type - ), - - NaturalFold => dhall::expr!( - Natural -> - forall (natural: Type) -> - forall (succ: natural -> natural) -> - forall (zero: natural) -> - natural - ), - NaturalBuild => dhall::expr!( - (forall (natural: Type) -> - forall (succ: natural -> natural) -> - forall (zero: natural) -> - natural) -> - Natural - ), - NaturalIsZero | NaturalEven | NaturalOdd => dhall::expr!( - Natural -> Bool - ), - NaturalToInteger => dhall::expr!(Natural -> Integer), - NaturalShow => dhall::expr!(Natural -> Text), - - IntegerToDouble => dhall::expr!(Integer -> Double), - IntegerShow => dhall::expr!(Integer -> Text), - DoubleShow => dhall::expr!(Double -> Text), - TextShow => dhall::expr!(Text -> Text), - - ListBuild => dhall::expr!( - forall (a: Type) -> - (forall (list: Type) -> - forall (cons: a -> list -> list) -> - forall (nil: list) -> - list) -> - List a - ), - ListFold => dhall::expr!( - forall (a: Type) -> - List a -> - forall (list: Type) -> - forall (cons: a -> list -> list) -> - forall (nil: list) -> - list - ), - ListLength => dhall::expr!(forall (a: Type) -> List a -> Natural), - ListHead | ListLast => { - dhall::expr!(forall (a: Type) -> List a -> Optional a) - } - ListIndexed => dhall::expr!( - forall (a: Type) -> - List a -> - List { index: Natural, value: a } - ), - ListReverse => dhall::expr!( - forall (a: Type) -> List a -> List a - ), - - OptionalBuild => dhall::expr!( - forall (a: Type) -> - (forall (optional: Type) -> - forall (just: a -> optional) -> - forall (nothing: optional) -> - optional) -> - Optional a - ), - OptionalFold => dhall::expr!( - forall (a: Type) -> - Optional a -> - forall (optional: Type) -> - forall (just: a -> optional) -> - forall (nothing: optional) -> - optional - ), - OptionalNone => dhall::expr!( - forall (a: Type) -> Optional a - ), - } -} macro_rules! ensure_equal { ($x:expr, $y:expr, $err:expr $(,)*) => { @@ -399,16 +197,147 @@ impl TypeIntermediate { } } +fn function_check(a: Const, b: Const) -> Result<Const, ()> { + use dhall_syntax::Const::*; + match (a, b) { + (_, Type) => Ok(Type), + (Kind, Kind) => Ok(Kind), + (Sort, Sort) => Ok(Sort), + (Sort, Kind) => Ok(Sort), + _ => Err(()), + } +} + +// Equality up to alpha-equivalence (renaming of bound variables) +fn prop_equal<T, U>(eL0: T, eR0: U) -> bool +where + T: Borrow<Type>, + U: Borrow<Type>, +{ + eL0.borrow().to_value() == eR0.borrow().to_value() +} + +pub(crate) fn const_to_typed(c: Const) -> Typed { + match c { + Const::Sort => Typed::const_sort(), + _ => Typed::from_thunk_and_type( + Value::Const(c).into_thunk(), + type_of_const(c).unwrap(), + ), + } +} + +fn const_to_type(c: Const) -> Type { + Type(TypeInternal::Const(c)) +} + +pub(crate) fn type_of_const(c: Const) -> Result<Type, TypeError> { + match c { + Const::Type => Ok(Type::const_kind()), + Const::Kind => Ok(Type::const_sort()), + Const::Sort => { + return Err(TypeError::new( + &TypecheckContext::new(), + TypeMessage::Sort, + )) + } + } +} + +fn type_of_builtin<E>(b: Builtin) -> Expr<X, E> { + use dhall_syntax::Builtin::*; + match b { + Bool | Natural | Integer | Double | Text => dhall::expr!(Type), + List | Optional => dhall::expr!( + Type -> Type + ), + + NaturalFold => dhall::expr!( + Natural -> + forall (natural: Type) -> + forall (succ: natural -> natural) -> + forall (zero: natural) -> + natural + ), + NaturalBuild => dhall::expr!( + (forall (natural: Type) -> + forall (succ: natural -> natural) -> + forall (zero: natural) -> + natural) -> + Natural + ), + NaturalIsZero | NaturalEven | NaturalOdd => dhall::expr!( + Natural -> Bool + ), + NaturalToInteger => dhall::expr!(Natural -> Integer), + NaturalShow => dhall::expr!(Natural -> Text), + + IntegerToDouble => dhall::expr!(Integer -> Double), + IntegerShow => dhall::expr!(Integer -> Text), + DoubleShow => dhall::expr!(Double -> Text), + TextShow => dhall::expr!(Text -> Text), + + ListBuild => dhall::expr!( + forall (a: Type) -> + (forall (list: Type) -> + forall (cons: a -> list -> list) -> + forall (nil: list) -> + list) -> + List a + ), + ListFold => dhall::expr!( + forall (a: Type) -> + List a -> + forall (list: Type) -> + forall (cons: a -> list -> list) -> + forall (nil: list) -> + list + ), + ListLength => dhall::expr!(forall (a: Type) -> List a -> Natural), + ListHead | ListLast => { + dhall::expr!(forall (a: Type) -> List a -> Optional a) + } + ListIndexed => dhall::expr!( + forall (a: Type) -> + List a -> + List { index: Natural, value: a } + ), + ListReverse => dhall::expr!( + forall (a: Type) -> List a -> List a + ), + + OptionalBuild => dhall::expr!( + forall (a: Type) -> + (forall (optional: Type) -> + forall (just: a -> optional) -> + forall (nothing: optional) -> + optional) -> + Optional a + ), + OptionalFold => dhall::expr!( + forall (a: Type) -> + Optional a -> + forall (optional: Type) -> + forall (just: a -> optional) -> + forall (nothing: optional) -> + optional + ), + OptionalNone => dhall::expr!( + forall (a: Type) -> Optional a + ), + } +} + /// Takes an expression that is meant to contain a Type /// and turn it into a type, typechecking it along the way. -fn mktype( +pub(crate) fn mktype( ctx: &TypecheckContext, e: SubExpr<Span, Normalized>, ) -> Result<Type, TypeError> { Ok(type_with(ctx, e)?.to_type()) } -fn builtin_to_type(b: Builtin) -> Result<Type, TypeError> { +pub(crate) fn builtin_to_type(b: Builtin) -> Result<Type, TypeError> { mktype( &TypecheckContext::new(), SubExpr::from_expr_no_note(ExprF::Builtin(b)), |