Add a new environment machine normalizer

dhall/benchmark/examples/normalize/ChurchEval.dhall

@@ -0,0 +1,22 @@
+
+let Nat = ∀(N : Type) → (N → N) → N → N
+let n2  = λ(N : Type) → λ(s : N → N) → λ(z : N) → s (s z)
+let n5  = λ(N : Type) → λ(s : N → N) → λ(z : N) → s (s (s (s (s z))))
+
+let mul =
+  λ(a : Nat) → λ(b : Nat) → λ(N : Type) → λ(s : N → N) → λ(z : N) → a N (b N s) z
+
+let add =
+  λ(a : Nat) → λ(b : Nat) → λ(N : Type) → λ(s : N → N) → λ(z : N) → a N s (b N s z)
+
+let n10   = mul n2 n5
+let n100  = mul n10 n10
+let n1k   = mul n10 n100
+let n10k  = mul n100 n100
+let n100k = mul n10 n10k
+let n1M   = mul n10k n100
+let n5M   = mul n1M n5
+let n10M  = mul n1M n10
+let n20M  = mul n10M n2
+
+in n1M Natural (λ (x:Natural) → x + 1) 0

dhall/benchmark/examples/normalize/FunCompose.dhall

@@ -0,0 +1,18 @@
+
+let compose
+    : ∀(a : Type) → ∀(b : Type) → ∀(c : Type) → (a → b) → (b → c) → a → c
+    =   λ(A : Type)
+      → λ(B : Type)
+      → λ(C : Type)
+      → λ(f : A → B)
+      → λ(g : B → C)
+      → λ(x : A)
+      → g (f x)
+
+let composeN : ∀ (a : Type) → Natural → (a → a) → a → a
+    = λ (a : Type)
+	→ λ (n : Natural)
+	→ λ (f : a → a)
+	→ Natural/fold n (a → a) (compose a a a f) (λ (x : a) → x)
+
+in composeN Natural 100000 (λ (x : Natural) → x + 1) 0

dhall/benchmark/examples/normalize/ListBench.dhall

@@ -0,0 +1,75 @@
+
+let iterate
+    =   λ(n : Natural)
+      → λ(a : Type)
+      → λ(f : a → a)
+      → λ(x : a)
+      → List/build
+        a
+        (   λ(list : Type)
+          → λ(cons : a → list → list)
+          → List/fold
+            { index : Natural, value : {} }
+            ( List/indexed
+              {}
+              ( List/build
+                {}
+                (   λ(list : Type)
+                  → λ(cons : {} → list → list)
+                  → Natural/fold n list (cons {=})
+                )
+              )
+            )
+            list
+            (   λ(y : { index : Natural, value : {} })
+              → cons (Natural/fold y.index a f x)
+            )
+        )
+
+let countTo =
+  λ (x : Natural)
+  → iterate x Natural (λ (x : Natural) → x + 1) 0
+
+let sum =
+  λ (xs : List Natural)
+  → List/fold Natural xs Natural (λ (x : Natural) → λ (acc : Natural) → x + acc) 0
+
+
+let map
+        : ∀(a : Type) → ∀(b : Type) → (a → b) → List a → List b
+        =   λ(a : Type)
+          → λ(b : Type)
+          → λ(f : a → b)
+          → λ(xs : List a)
+          → List/build
+            b
+            (   λ(list : Type)
+              → λ(cons : b → list → list)
+              → List/fold a xs list (λ(x : a) → cons (f x))
+            )
+
+let any
+        : ∀(a : Type) → (a → Bool) → List a → Bool
+        =   λ(a : Type)
+          → λ(f : a → Bool)
+          → λ(xs : List a)
+          → List/fold a xs Bool (λ(x : a) → λ(r : Bool) → f x || r) False
+
+let filter
+        : ∀(a : Type) → (a → Bool) → List a → List a
+        =   λ(a : Type)
+          → λ(f : a → Bool)
+          → λ(xs : List a)
+          → List/build
+            a
+            (   λ(list : Type)
+              → λ(cons : a → list → list)
+              → List/fold
+                a
+                xs
+                list
+                (λ(x : a) → λ(xs : list) → if f x then cons x xs else xs)
+            )
+
+in sum (filter Natural Natural/even
+     (map Natural Natural (λ(x:Natural) → x + 10) (countTo 1000)))

dhall/benchmark/examples/normalize/ListBenchAlt.dhall

@@ -0,0 +1,45 @@
+
+let iterate =
+    λ(n : Natural)
+  → λ(a : Type)
+  → λ(f : a → a)
+  → λ(x : a)
+  → (Natural/fold n
+      (a → List a → {fst:a, snd:List a})
+	  (λ (hyp : a → List a → {fst:a, snd:List a}) →
+	   λ (x : a) → λ (xs : List a)
+	   → let tup = hyp x xs
+	     in {fst = f (tup.fst), snd = tup.snd # [tup.fst]})
+	  (λ (x : a) → λ (xs : List a) → {fst=x, snd=xs})
+	  x ([] : List a)).snd
+
+let countTo =
+  λ (x : Natural)
+  → iterate x Natural (λ (x : Natural) → x + 1) 0
+
+let sum =
+  λ (xs : List Natural)
+  → List/fold Natural xs Natural (λ (x : Natural) → λ (acc : Natural) → x + acc) 0
+
+let map
+  =   λ(a : Type)
+    → λ(b : Type)
+    → λ(f : a → b)
+    → λ(xs : List a)
+	→ List/fold a xs (List b) (λ (x : a) → λ (xs : List b) → [f x] # xs) ([] : List b)
+
+let any
+  =   λ(a : Type)
+        → λ(f : a → Bool)
+        → λ(xs : List a)
+        → List/fold a xs Bool (λ(x : a) → λ(r : Bool) → f x || r) False
+
+let filter
+  =   λ(a : Type)
+    → λ(f : a → Bool)
+    → λ(xs : List a)
+	→ List/fold a xs (List a)
+	    (λ (x : a) → λ (xs : List a) → if f x then [x] # xs else xs) ([] : List a)
+
+in sum (filter Natural Natural/even
+     (map Natural Natural (λ(x:Natural) → x + 10) (countTo 1000)))

dhall/dhall.cabal

@@ -25,6 +25,7 @@ Category: Compiler
 Extra-Source-Files:
     benchmark/deep-nested-large-record/*.dhall
     benchmark/examples/*.dhall
+    benchmark/examples/normalize/*.dhall
     CHANGELOG.md
     dhall-lang/Prelude/Bool/and
     dhall-lang/Prelude/Bool/build
@@ -441,7 +442,8 @@ Library
         Dhall.Repl,
         Dhall.TH,
         Dhall.Tutorial,
-        Dhall.TypeCheck
+        Dhall.TypeCheck,
+        Dhall.Eval
     Other-Modules:
         Dhall.Pretty.Internal,
         Dhall.Parser.Expression,

dhall/src/Dhall.hs

@@ -185,7 +185,7 @@ instance (Pretty s, Pretty a, Typeable s, Typeable a) => Show (InvalidType s a)
         where
           txt0 = Dhall.Util.insert invalidTypeExpected
           txt1 = Dhall.Util.insert invalidTypeExpression
-            
+
 
 instance (Pretty s, Pretty a, Typeable s, Typeable a) => Exception (InvalidType s a)
 
@@ -231,7 +231,7 @@ sourceName k s =
 -- | @since 1.16
 data EvaluateSettings = EvaluateSettings
   { _startingContext :: Dhall.Context.Context (Expr Src X)
-  , _normalizer      :: Dhall.Core.ReifiedNormalizer X
+  , _normalizer      :: Maybe (Dhall.Core.ReifiedNormalizer X)
   , _standardVersion :: StandardVersion
   }
 
@@ -242,7 +242,7 @@ data EvaluateSettings = EvaluateSettings
 defaultEvaluateSettings :: EvaluateSettings
 defaultEvaluateSettings = EvaluateSettings
   { _startingContext = Dhall.Context.empty
-  , _normalizer      = Dhall.Core.ReifiedNormalizer (const (pure Nothing))
+  , _normalizer      = Nothing
   , _standardVersion = Dhall.Binary.defaultStandardVersion
   }
 
@@ -263,11 +263,11 @@ startingContext = evaluateSettings . l
 -- @since 1.16
 normalizer
   :: (Functor f, HasEvaluateSettings s)
-  => LensLike' f s (Dhall.Core.ReifiedNormalizer X)
+  => LensLike' f s (Maybe (Dhall.Core.ReifiedNormalizer X))
 normalizer = evaluateSettings . l
   where
     l :: (Functor f)
-      => LensLike' f EvaluateSettings (Dhall.Core.ReifiedNormalizer X)
+      => LensLike' f EvaluateSettings (Maybe (Dhall.Core.ReifiedNormalizer X))
     l k s = fmap (\x -> s { _normalizer = x }) (k (_normalizer s))
 
 -- | Access the standard version (used primarily when encoding or decoding
@@ -360,10 +360,8 @@ inputWithSettings settings (Type {..}) txt = do
             _ ->
                 Annot expr' expected
     _ <- throws (Dhall.TypeCheck.typeWith (view startingContext settings) annot)
-    let normExpr = Dhall.Core.normalizeWith
-                     (Dhall.Core.getReifiedNormalizer
-                       (view normalizer settings))
-                     expr'
+    let normExpr = Dhall.Core.normalizeWith (view normalizer settings) expr'
+
     case extract normExpr  of
         Just x  -> return x
         Nothing -> Control.Exception.throwIO
@@ -450,7 +448,7 @@ inputExprWithSettings settings txt = do
     expr' <- State.evalStateT (Dhall.Import.loadWith expr) status
 
     _ <- throws (Dhall.TypeCheck.typeWith (view startingContext settings) expr')
-    pure (Dhall.Core.normalizeWith (Dhall.Core.getReifiedNormalizer (view normalizer settings)) expr')
+    pure (Dhall.Core.normalizeWith (view normalizer settings) expr')
 
 -- | Use this function to extract Haskell values directly from Dhall AST.
 --   The intended use case is to allow easy extraction of Dhall values for
@@ -834,7 +832,7 @@ instance Interpret a => Interpret (Vector a) where
 instance (Inject a, Interpret b) => Interpret (a -> b) where
     autoWith opts = Type extractOut expectedOut
       where
-        normalizer_ = Dhall.Core.getReifiedNormalizer (inputNormalizer opts)
+        normalizer_ = Just (inputNormalizer opts)
 
         extractOut e = Just (\i -> case extractIn (Dhall.Core.normalizeWith normalizer_ (App e (embed i))) of
             Just o  -> o