#![allow(non_snake_case)] use std::fmt; use dhall_core::context::Context; use dhall_core::*; use dhall_generator as dhall; use crate::expr::*; 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_value(&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_value(&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: Vec> = rest.iter().map(ExprF::roll).collect(); Continue(ExprF::App(ret, rest)) } #[derive(Debug, Clone, PartialEq, Eq)] enum Value { Expr(SubExpr), Lam( Label, SubExpr>, SubExpr>, ), AppliedBuiltin(Builtin, Vec), } impl Value { fn into_expr(self, ctx: &NormalizationContext) -> SubExpr { match self { Value::Expr(e) => e, Value::Lam(x, t, e) => rc(ExprF::Lam( x.clone(), normalize_value(ctx, t).into_expr(ctx), normalize_value(&ctx.skip(&x), e).into_expr(&ctx.skip(&x)), )), Value::AppliedBuiltin(b, args) if args.is_empty() => { rc(ExprF::Builtin(b)) } Value::AppliedBuiltin(b, args) => { let args_rolled: Vec<_> = args.iter().map(|val| val.clone().into_expr(ctx)).collect(); rc(ExprF::App(rc(ExprF::Builtin(b)), args_rolled)) } } } } #[derive(Debug, Clone)] enum EnvItem { Expr(SubExpr), Skip(usize), } struct NormalizationContext(Context); impl NormalizationContext { fn new() -> NormalizationContext { NormalizationContext(Context::new()) } fn insert(&self, x: &Label, e: SubExpr) -> 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(shift0(1, x, e)), Skip(n) if l == x => Skip(*n + 1), Skip(n) => Skip(*n), } }) .insert(x.clone(), EnvItem::Skip(0)), ) } fn lookup(&self, var: &V