#![allow(non_snake_case)] use std::collections::BTreeMap; use std::fmt; use dhall_core::context::Context; use dhall_core::*; use dhall_generator as dhall; use crate::expr::*; type InputSubExpr = SubExpr>; type OutputSubExpr = SubExpr; impl<'a> Typed<'a> { pub fn normalize(self) -> Normalized<'a> { Normalized(normalize(self.0), self.1, self.2) } /// Pretends this expression is normalized. Use with care. #[allow(dead_code)] pub fn skip_normalize(self) -> Normalized<'a> { Normalized( self.0.unroll().squash_embed(|e| e.0.clone()), self.1, self.2, ) } } fn apply_builtin(b: Builtin, args: &[Expr]) -> WhatNext where N: fmt::Debug + Clone, E: fmt::Debug + Clone, { use dhall_core::Builtin::*; use dhall_core::ExprF::*; use WhatNext::*; let (ret, rest) = match (b, args) { (OptionalNone, [t, rest..]) => (rc(EmptyOptionalLit(t.roll())), rest), (NaturalIsZero, [NaturalLit(n), rest..]) => { (rc(BoolLit(*n == 0)), rest) } (NaturalEven, [NaturalLit(n), rest..]) => { (rc(BoolLit(*n % 2 == 0)), rest) } (NaturalOdd, [NaturalLit(n), rest..]) => { (rc(BoolLit(*n % 2 != 0)), rest) } (NaturalToInteger, [NaturalLit(n), rest..]) => { (rc(IntegerLit(*n as isize)), rest) } (NaturalShow, [NaturalLit(n), rest..]) => { (rc(TextLit(n.to_string().into())), rest) } (ListLength, [_, EmptyListLit(_), rest..]) => (rc(NaturalLit(0)), rest), (ListLength, [_, NEListLit(ys), rest..]) => { (rc(NaturalLit(ys.len())), rest) } (ListHead, [_, EmptyListLit(t), rest..]) => { (rc(EmptyOptionalLit(t.clone())), rest) } (ListHead, [_, NEListLit(ys), rest..]) => { (rc(NEOptionalLit(ys.first().unwrap().clone())), rest) } (ListLast, [_, EmptyListLit(t), rest..]) => { (rc(EmptyOptionalLit(t.clone())), rest) } (ListLast, [_, NEListLit(ys), rest..]) => { (rc(NEOptionalLit(ys.last().unwrap().clone())), rest) } (ListReverse, [_, EmptyListLit(t), rest..]) => { (rc(EmptyListLit(t.clone())), rest) } (ListReverse, [_, NEListLit(ys), rest..]) => { let ys = ys.iter().rev().cloned().collect(); (rc(NEListLit(ys)), rest) } (ListIndexed, [_, EmptyListLit(t), rest..]) => ( dhall::subexpr!([] : List ({ index : Natural, value : t })), rest, ), (ListIndexed, [_, NEListLit(xs), rest..]) => { let xs = xs .iter() .cloned() .enumerate() .map(|(i, e)| { let i = rc(NaturalLit(i)); dhall::subexpr!({ index = i, value = e }) }) .collect(); (rc(NEListLit(xs)), rest) } (ListBuild, [a0, g, rest..]) => { 'ret: { // if let App(f2, args2) = g { // if let (Builtin(ListFold), [_, x, rest_inner..]) = // (f2.as_ref(), args2.as_slice()) // { // // fold/build fusion // break 'ret ( // rc(App(x.clone(), rest_inner.to_vec())), // rest, // ); // } // }; let a0 = a0.roll(); let a1 = shift0(1, &"x".into(), &a0); let g = g.roll(); break 'ret ( dhall::subexpr!( g (List a0) (λ(x : a0) -> λ(xs : List a1) -> [ x ] # xs) ([] : List a0) ), rest, ); } } (OptionalBuild, [a0, g, rest..]) => { 'ret: { // if let App(f2, args2) = g { // if let (Builtin(OptionalFold), [_, x, rest_inner..]) = // (f2.as_ref(), args2.as_slice()) // { // // fold/build fusion // break 'ret ( // rc(App(x.clone(), rest_inner.to_vec())), // rest, // ); // } // }; let a0 = a0.roll(); let g = g.roll(); break 'ret ( dhall::subexpr!( g (Optional a0) (λ(x: a0) -> Some x) (None a0) ), rest, ); } } (ListFold, [_, EmptyListLit(_), _, _, nil, rest..]) => { (nil.roll(), rest) } (ListFold, [_, NEListLit(xs), _, cons, nil, rest..]) => ( xs.iter().rev().fold(nil.roll(), |acc, x| { let x = x.clone(); let acc = acc.clone(); let cons = cons.roll(); dhall::subexpr!(cons x acc) }), rest, ), // // fold/build fusion // (ListFold, [_, App(box Builtin(ListBuild), [_, x, rest..]), rest..]) => { // normalize_whnf(&App(bx(x.clone()), rest.to_vec())) // } (OptionalFold, [_, NEOptionalLit(x), _, just, _, rest..]) => { let x = x.clone(); let just = just.roll(); (dhall::subexpr!(just x), rest) } (OptionalFold, [_, EmptyOptionalLit(_), _, _, nothing, rest..]) => { (nothing.roll(), rest) } // // fold/build fusion // (OptionalFold, [_, App(box Builtin(OptionalBuild), [_, x, rest..]), rest..]) => { // normalize_whnf(&App(bx(x.clone()), rest.to_vec())) // } (NaturalBuild, [g, rest..]) => { 'ret: { // if let App(f2, args2) = g { // if let (Builtin(NaturalFold), [x, rest_inner..]) = // (f2.as_ref(), args2.as_slice()) // { // // fold/build fusion // break 'ret ( // rc(App(x.clone(), rest_inner.to_vec())), // rest, // ); // } // }; let g = g.roll(); break 'ret ( dhall::subexpr!(g Natural (λ(x : Natural) -> x + 1) 0), rest, ); } } (NaturalFold, [NaturalLit(0), _, _, zero, rest..]) => { (zero.roll(), rest) } (NaturalFold, [NaturalLit(n), t, succ, zero, rest..]) => { let fold = rc(Builtin(NaturalFold)); let n = rc(NaturalLit(n - 1)); let t = t.roll(); let succ = succ.roll(); let zero = zero.roll(); (dhall::subexpr!(succ (fold n t succ zero)), rest) } // (NaturalFold, Some(App(f2, args2)), _) => { // match (f2.as_ref(), args2.as_slice()) { // // fold/build fusion // (Builtin(NaturalBuild), [x, rest..]) => { // rc(App(x.clone(), rest.to_vec())) // } // _ => return rc(App(f, args)), // } // } _ => return DoneAsIs, }; // Put the remaining arguments back and eval again. In most cases // ret will not be of a form that can be applied, so this won't go very deep. // In lots of cases, there are no remaining args so this cann will just return ret. let rest = rest.iter().map(ExprF::roll); Continue(rest.fold(ret, |acc, e| rc(ExprF::App(acc, e))).unroll()) } // #[derive(Debug, Clone)] // struct ContextualizedSubExpr { // ctx: NormalizationContext, // expr: SubExpr>, // } // impl ContextualizedSubExpr { // fn normalize_whnf(self) -> WHNF { // normalize_whnf(&self.ctx, self.expr) // } // fn normalize_expr(self) -> OutputSubExpr { // normalize_whnf(&self.ctx, self.expr).into_expr(&self.ctx) // } // } /// A semantic value. This is partially redundant with `dhall_core::Expr`, on purpose. `Expr` should /// be limited to syntactic expressions: either written by the user or meant to be printed. /// The rule is the following: we must _not_ construct values of type `Expr` while normalizing or /// typechecking, but only construct `WHNF`s. /// /// WHNFs usually store subexpressions unnormalized, to enable lazy normalization. They approximate /// what's called Weak Head Normal-Form (WHNF). This means that the expression is normalized as /// little as possible, but just enough to know the first constructor of the normal form. This is /// identical to full normalization for simple types like integers, but for e.g. a record literal /// this means knowing just the field names. #[derive(Debug, Clone)] enum WHNF { Closure(Closure), BoolLit(bool), NaturalLit(Natural), EmptyListLit(NormalizationContext, InputSubExpr), NEListLit(Vec<(NormalizationContext, Vec)>), RecordLit(NormalizationContext, BTreeMap), UnionType(NormalizationContext, BTreeMap>), Expr(OutputSubExpr), } impl WHNF { /// Convert the value back to a (normalized) syntactic expression fn normalize_to_expr(self) -> OutputSubExpr { match self { WHNF::Closure(c) => c.normalize_to_expr(), WHNF::BoolLit(b) => rc(ExprF::BoolLit(b)), WHNF::NaturalLit(n) => rc(ExprF::NaturalLit(n)), WHNF::EmptyListLit(ctx, e) => rc(ExprF::EmptyListLit( normalize_whnf(&ctx, e).normalize_to_expr(), )), WHNF::NEListLit(elts) => rc(ExprF::NEListLit( elts.into_iter() .flat_map(|(ctx, vs)| { vs.into_iter().map(move |v| { normalize_whnf(&ctx, v).normalize_to_expr() }) }) .collect(), )), WHNF::RecordLit(ctx, kvs) => rc(ExprF::RecordLit( kvs.into_iter() .map(|(k, v)| { (k, normalize_whnf(&ctx, v).normalize_to_expr()) }) .collect(), )), WHNF::UnionType(ctx, kvs) => rc(ExprF::UnionType( kvs.into_iter() .map(|(k, v)| { ( k, v.map(|v| { normalize_whnf(&ctx, v).normalize_to_expr() }), ) }) .collect(), )), WHNF::Expr(e) => e, } } fn shift0(self, delta: isize, label: &Label) -> Self { match self { WHNF::Closure(c) => WHNF::Closure(c.shift0(delta, label)), WHNF::Expr(e) => WHNF::Expr(shift0(delta, label, &e)), WHNF::BoolLit(b) => WHNF::BoolLit(b), WHNF::NaturalLit(n) => WHNF::NaturalLit(n), WHNF::EmptyListLit(ctx, e) => { WHNF::EmptyListLit(ctx, shift0(delta, label, &e)) } WHNF::NEListLit(elts) => WHNF::NEListLit( elts.into_iter() .map(|(ctx, vs)| { ( ctx, vs.into_iter() .map(|v| shift0(delta, label, &v)) .collect(), ) }) .collect(), ), WHNF::RecordLit(ctx, kvs) => WHNF::RecordLit( ctx, kvs.into_iter() .map(|(k, v)| (k, shift0(delta, label, &v))) .collect(), ), WHNF::UnionType(ctx, kvs) => WHNF::UnionType( ctx, kvs.into_iter() .map(|(k, v)| (k, v.map(|v| shift0(delta, label, &v)))) .collect(), ), } } } #[derive(Debug, Clone)] enum Closure { Lam(NormalizationContext, Label, InputSubExpr, InputSubExpr), AppliedBuiltin(NormalizationContext, Builtin, Vec), UnionConstructor( NormalizationContext, Label, BTreeMap>, ), } impl Closure { /// Apply the closure to a value fn app(self, val: WHNF) -> WHNF { match self { Closure::Lam(ctx, x, _, e) => { let ctx2 = ctx.insert(&x, val); normalize_whnf(&ctx2, e) } Closure::AppliedBuiltin(ctx, b, mut args) => { args.push(val); let args_unrolled: Vec<_> = args .iter() .map(|val| val.clone().normalize_to_expr().unroll()) .collect(); match apply_builtin(b, &args_unrolled).into_value(&ctx) { Some(v) => v, None => { WHNF::Closure(Closure::AppliedBuiltin(ctx, b, args)) } } } Closure::UnionConstructor(ctx, l, kts) => { let kts = kts .into_iter() .map(|(k, v)| { ( k, v.map(|v| { normalize_whnf(&ctx, v).normalize_to_expr() }), ) }) .collect(); WHNF::Expr(rc(ExprF::UnionLit(l, val.normalize_to_expr(), kts))) } } } /// Convert the closure back to a (normalized) syntactic expression fn normalize_to_expr(self) -> OutputSubExpr { match self { Closure::Lam(ctx, x, t, e) => { let ctx2 = ctx.skip(&x); rc(ExprF::Lam( x.clone(), normalize_whnf(&ctx, t).normalize_to_expr(), normalize_whnf(&ctx2, e).normalize_to_expr(), )) } Closure::AppliedBuiltin(_ctx, b, args) => { if args.is_empty() { rc(ExprF::Builtin(b)) } else { args.into_iter() .map(|e| e.normalize_to_expr()) .fold(rc(ExprF::Builtin(b)), |acc, e| { rc(ExprF::App(acc, e)) }) } } Closure::UnionConstructor(ctx, l, kts) => { let kts = kts .into_iter() .map(|(k, v)| { ( k, v.map(|v| { normalize_whnf(&ctx, v).normalize_to_expr() }), ) }) .collect(); rc(ExprF::Field(rc(ExprF::UnionType(kts)), l)) } } } fn shift0(self, delta: isize, label: &Label) -> Self { match self { Closure::Lam(ctx, x, t, e) => Closure::Lam( ctx, x, shift0(delta, label, &t), shift(delta, &V(label.clone(), 1), &e), ), Closure::AppliedBuiltin(ctx, b, args) => Closure::AppliedBuiltin( ctx, b, args.into_iter().map(|e| e.shift0(delta, label)).collect(), ), Closure::UnionConstructor(ctx, l, kts) => { let kts = kts .into_iter() .map(|(k, v)| (k, v.map(|v| shift0(delta, label, &v)))) .collect(); Closure::UnionConstructor(ctx, l, kts) } } } } #[derive(Debug, Clone)] enum EnvItem { Expr(WHNF), Skip(usize), } #[derive(Debug, Clone)] struct NormalizationContext(Context); impl NormalizationContext { fn new() -> NormalizationContext { NormalizationContext(Context::new()) } fn insert(&self, x: &Label, e: WHNF) -> NormalizationContext { NormalizationContext(self.0.insert(x.clone(), EnvItem::Expr(e))) } fn skip(&self, x: &Label) -> NormalizationContext { NormalizationContext( self.0 .map(|l, e| { use EnvItem::*; match e { Expr(e) => Expr(e.clone().shift0(1, x)), Skip(n) if l == x => Skip(*n + 1), Skip(n) => Skip(*n), } }) .insert(x.clone(), EnvItem::Skip(0)), ) } fn lookup(&self, var: &V