{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
module Dhall.Nix (
dhallToNix
, CompileError(..)
) where
import Control.Exception (Exception)
import Data.Fix (Fix (..))
import Data.Foldable (toList)
import Data.Text (Text)
import Data.Traversable (for)
import Data.Typeable (Typeable)
import Data.Void (Void, absurd)
import Dhall.Core
( Binding (..)
, Chunks (..)
, DhallDouble (..)
, Expr (..)
, FunctionBinding (..)
, MultiLet (..)
, PreferAnnotation (..)
, Var (..)
)
import Lens.Family (toListOf)
import Nix.Atoms (NAtom (..))
import Nix.Expr
( Antiquoted (..)
, Binding (..)
, NBinaryOp (..)
, NExprF (..)
, NKeyName (..)
, NRecordType (..)
, NString (..)
, Params (..)
, ($+)
, (==>)
, (@@)
, (@.)
)
import qualified Data.Text
import qualified Dhall.Core
import qualified Dhall.Map
import qualified Dhall.Optics
import qualified NeatInterpolation
import qualified Nix
data CompileError
= CannotReferenceShadowedVariable Var
| CannotProjectByType
deriving (Typeable)
instance Show CompileError where
show :: CompileError -> String
show (CannotReferenceShadowedVariable Var
v) =
Text -> String
Data.Text.unpack [NeatInterpolation.text|
$_ERROR: Cannot reference shadowed variable
Explanation: Whenever you introduce two variables of the same name, the latter
variable takes precedence:
This ❰x❱ ...
⇩
┌───────────────────────────────┐
│ λ(x : Text) → λ(x : Text) → x │
└───────────────────────────────┘
⇧
... refers to this ❰x❱
The former variable is "shadowed":
┌───────────────────────────────┐
│ λ(x : Text) → λ(x : Text) → x │
└───────────────────────────────┘
⇧
This ❰x❱ is shadowed
... and Dhall lets you reference shadowed variables using the ❰@❱ notation:
This ❰x❱ ...
⇩
┌─────────────────────────────────┐
│ λ(x : Text) → λ(x : Text) → x@1 │
└─────────────────────────────────┘
⇧
... now refers to this ❰x❱
However, the Nix language does not let you reference shadowed variables and
there is nothing analogous to ❰@❱ in Nix
Your code contains the following expression:
↳ $txt
... which references a shadowed variable and therefore cannot be translated to
Nix
|]
where
txt :: Text
txt = Var -> Text
forall a. Pretty a => a -> Text
Dhall.Core.pretty Var
v
show CompileError
CannotProjectByType =
Text -> String
Data.Text.unpack [NeatInterpolation.text|
$_ERROR: Cannot project by type
The ❰dhall-to-nix❱ compiler does not support projecting out a subset of a record
by the expected type (i.e. ❰someRecord.(someType)❱
|]
_ERROR :: Data.Text.Text
_ERROR :: Text
_ERROR = Text
"\ESC[1;31mError\ESC[0m"
instance Exception CompileError
dhallToNix :: Expr s Void -> Either CompileError (Fix NExprF)
dhallToNix :: Expr s Void -> Either CompileError (Fix NExprF)
dhallToNix Expr s Void
e =
Expr Any Void -> Either CompileError (Fix NExprF)
forall s. Expr s Void -> Either CompileError (Fix NExprF)
loop (Expr Any Void -> Expr Any Void
forall s. Expr s Void -> Expr s Void
rewriteShadowed (Expr s Void -> Expr Any Void
forall a s t. Eq a => Expr s a -> Expr t a
Dhall.Core.normalize Expr s Void
e))
where
untranslatable :: Fix NExprF
untranslatable = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NRecordType -> [Binding (Fix NExprF)] -> NExprF (Fix NExprF)
forall r. NRecordType -> [Binding r] -> NExprF r
NSet NRecordType
NNonRecursive [])
maximumDepth :: Var -> Expr s Void -> Maybe Int
maximumDepth :: Var -> Expr s Void -> Maybe Int
maximumDepth v :: Var
v@(V Text
x Int
n) (Lam Maybe CharacterSet
_ FunctionBinding {functionBindingVariable :: forall s a. FunctionBinding s a -> Text
functionBindingVariable = Text
x', functionBindingAnnotation :: forall s a. FunctionBinding s a -> Expr s a
functionBindingAnnotation = Expr s Void
a} Expr s Void
b)
| Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
x' =
Maybe Int -> Maybe Int -> Maybe Int
forall a. Ord a => a -> a -> a
max (Var -> Expr s Void -> Maybe Int
forall s. Var -> Expr s Void -> Maybe Int
maximumDepth Var
v Expr s Void
a) ((Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Var -> Expr s Void -> Maybe Int
forall s. Var -> Expr s Void -> Maybe Int
maximumDepth (Text -> Int -> Var
V Text
x (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) Expr s Void
b))
maximumDepth v :: Var
v@(V Text
x Int
n) (Pi Maybe CharacterSet
_ Text
x' Expr s Void
a Expr s Void
b)
| Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
x' =
Maybe Int -> Maybe Int -> Maybe Int
forall a. Ord a => a -> a -> a
max (Var -> Expr s Void -> Maybe Int
forall s. Var -> Expr s Void -> Maybe Int
maximumDepth Var
v Expr s Void
a) ((Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Var -> Expr s Void -> Maybe Int
forall s. Var -> Expr s Void -> Maybe Int
maximumDepth (Text -> Int -> Var
V Text
x (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) Expr s Void
b))
maximumDepth (V Text
x Int
n) (Let (Binding { variable :: forall s a. Binding s a -> Text
variable = Text
x' }) Expr s Void
a)
| Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
x' = (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Var -> Expr s Void -> Maybe Int
forall s. Var -> Expr s Void -> Maybe Int
maximumDepth (Text -> Int -> Var
V Text
x (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) Expr s Void
a)
maximumDepth Var
v (Var Var
v')
| Var
v Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
v' = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0
maximumDepth Var
v Expr s Void
expression =
(Maybe Int -> Maybe Int -> Maybe Int)
-> Maybe Int -> [Maybe Int] -> Maybe Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Maybe Int -> Maybe Int -> Maybe Int
forall a. Ord a => a -> a -> a
max Maybe Int
forall a. Maybe a
Nothing
((Expr s Void -> Maybe Int) -> [Expr s Void] -> [Maybe Int]
forall a b. (a -> b) -> [a] -> [b]
map
(Var -> Expr s Void -> Maybe Int
forall s. Var -> Expr s Void -> Maybe Int
maximumDepth Var
v)
(FoldLike
[Expr s Void]
(Expr s Void)
(Expr s Void)
(Expr s Void)
(Expr s Void)
-> Expr s Void -> [Expr s Void]
forall a s t b. FoldLike [a] s t a b -> s -> [a]
toListOf FoldLike
[Expr s Void]
(Expr s Void)
(Expr s Void)
(Expr s Void)
(Expr s Void)
forall (f :: * -> *) s a.
Applicative f =>
(Expr s a -> f (Expr s a)) -> Expr s a -> f (Expr s a)
Dhall.Core.subExpressions Expr s Void
expression)
)
rename :: (Text, Expr s Void) -> Maybe (Text, Expr s Void)
rename :: (Text, Expr s Void) -> Maybe (Text, Expr s Void)
rename (Text
x, Expr s Void
expression) =
case Var -> Expr s Void -> Maybe Int
forall s. Var -> Expr s Void -> Maybe Int
maximumDepth (Text -> Int -> Var
V Text
x Int
0) Expr s Void
expression of
Maybe Int
Nothing ->
Maybe (Text, Expr s Void)
forall a. Maybe a
Nothing
Just Int
0 ->
Maybe (Text, Expr s Void)
forall a. Maybe a
Nothing
Just Int
n ->
(Text, Expr s Void) -> Maybe (Text, Expr s Void)
forall a. a -> Maybe a
Just
( Text
x'
, Var -> Expr s Void -> Expr s Void -> Expr s Void
forall s a. Var -> Expr s a -> Expr s a -> Expr s a
Dhall.Core.subst (Text -> Int -> Var
V Text
x Int
0) (Var -> Expr s Void
forall s a. Var -> Expr s a
Var (Text -> Int -> Var
V Text
x' Int
0)) (Int -> Var -> Expr s Void -> Expr s Void
forall s a. Int -> Var -> Expr s a -> Expr s a
Dhall.Core.shift Int
1 (Text -> Int -> Var
V Text
x' Int
0) Expr s Void
expression)
)
where
x' :: Text
x' = Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Data.Text.pack (Int -> String
forall a. Show a => a -> String
show Int
n)
renameShadowed :: Expr s Void -> Maybe (Expr s Void)
renameShadowed :: Expr s Void -> Maybe (Expr s Void)
renameShadowed (Lam Maybe CharacterSet
cs FunctionBinding { functionBindingVariable :: forall s a. FunctionBinding s a -> Text
functionBindingVariable = Text
x, functionBindingAnnotation :: forall s a. FunctionBinding s a -> Expr s a
functionBindingAnnotation = Expr s Void
a} Expr s Void
b) = do
(Text
x', Expr s Void
b') <- (Text, Expr s Void) -> Maybe (Text, Expr s Void)
forall s. (Text, Expr s Void) -> Maybe (Text, Expr s Void)
rename (Text
x, Expr s Void
b)
Expr s Void -> Maybe (Expr s Void)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe CharacterSet
-> FunctionBinding s Void -> Expr s Void -> Expr s Void
forall s a.
Maybe CharacterSet -> FunctionBinding s a -> Expr s a -> Expr s a
Lam Maybe CharacterSet
cs (Text -> Expr s Void -> FunctionBinding s Void
forall s a. Text -> Expr s a -> FunctionBinding s a
Dhall.Core.makeFunctionBinding Text
x' Expr s Void
a) Expr s Void
b')
renameShadowed (Pi Maybe CharacterSet
cs Text
x Expr s Void
a Expr s Void
b) = do
(Text
x', Expr s Void
b') <- (Text, Expr s Void) -> Maybe (Text, Expr s Void)
forall s. (Text, Expr s Void) -> Maybe (Text, Expr s Void)
rename (Text
x, Expr s Void
b)
Expr s Void -> Maybe (Expr s Void)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe CharacterSet
-> Text -> Expr s Void -> Expr s Void -> Expr s Void
forall s a.
Maybe CharacterSet -> Text -> Expr s a -> Expr s a -> Expr s a
Pi Maybe CharacterSet
cs Text
x' Expr s Void
a Expr s Void
b')
renameShadowed (Let Binding{ variable :: forall s a. Binding s a -> Text
variable = Text
x, Maybe s
Maybe (Maybe s, Expr s Void)
Expr s Void
bindingSrc0 :: forall s a. Binding s a -> Maybe s
bindingSrc1 :: forall s a. Binding s a -> Maybe s
annotation :: forall s a. Binding s a -> Maybe (Maybe s, Expr s a)
bindingSrc2 :: forall s a. Binding s a -> Maybe s
value :: forall s a. Binding s a -> Expr s a
value :: Expr s Void
bindingSrc2 :: Maybe s
annotation :: Maybe (Maybe s, Expr s Void)
bindingSrc1 :: Maybe s
bindingSrc0 :: Maybe s
.. } Expr s Void
a) = do
(Text
x' , Expr s Void
a') <- (Text, Expr s Void) -> Maybe (Text, Expr s Void)
forall s. (Text, Expr s Void) -> Maybe (Text, Expr s Void)
rename (Text
x, Expr s Void
a)
Expr s Void -> Maybe (Expr s Void)
forall (m :: * -> *) a. Monad m => a -> m a
return (Binding s Void -> Expr s Void -> Expr s Void
forall s a. Binding s a -> Expr s a -> Expr s a
Let Binding :: forall s a.
Maybe s
-> Text
-> Maybe s
-> Maybe (Maybe s, Expr s a)
-> Maybe s
-> Expr s a
-> Binding s a
Binding{ variable :: Text
variable = Text
x', Maybe s
Maybe (Maybe s, Expr s Void)
Expr s Void
bindingSrc0 :: Maybe s
bindingSrc1 :: Maybe s
annotation :: Maybe (Maybe s, Expr s Void)
bindingSrc2 :: Maybe s
value :: Expr s Void
value :: Expr s Void
bindingSrc2 :: Maybe s
annotation :: Maybe (Maybe s, Expr s Void)
bindingSrc1 :: Maybe s
bindingSrc0 :: Maybe s
.. } Expr s Void
a')
renameShadowed Expr s Void
_ =
Maybe (Expr s Void)
forall a. Maybe a
Nothing
rewriteShadowed :: Expr s Void -> Expr s Void
rewriteShadowed =
ASetter (Expr s Void) (Expr s Void) (Expr s Void) (Expr s Void)
-> (Expr s Void -> Maybe (Expr s Void))
-> Expr s Void
-> Expr s Void
forall a b. ASetter a b a b -> (b -> Maybe a) -> a -> b
Dhall.Optics.rewriteOf ASetter (Expr s Void) (Expr s Void) (Expr s Void) (Expr s Void)
forall (f :: * -> *) s a.
Applicative f =>
(Expr s a -> f (Expr s a)) -> Expr s a -> f (Expr s a)
Dhall.Core.subExpressions Expr s Void -> Maybe (Expr s Void)
forall s. Expr s Void -> Maybe (Expr s Void)
renameShadowed
loop :: Expr s Void -> Either CompileError (Fix NExprF)
loop (Const Const
_) = Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return Fix NExprF
untranslatable
loop (Var (V Text
a Int
0)) = Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Text -> NExprF (Fix NExprF)
forall r. Text -> NExprF r
NSym Text
a))
loop (Var Var
a ) = CompileError -> Either CompileError (Fix NExprF)
forall a b. a -> Either a b
Left (Var -> CompileError
CannotReferenceShadowedVariable Var
a)
loop (Lam Maybe CharacterSet
_ FunctionBinding { functionBindingVariable :: forall s a. FunctionBinding s a -> Text
functionBindingVariable = Text
a } Expr s Void
c) = do
Fix NExprF
c' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
c
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs (Text -> Params (Fix NExprF)
forall r. Text -> Params r
Param Text
a) Fix NExprF
c'))
loop (Pi Maybe CharacterSet
_ Text
_ Expr s Void
_ Expr s Void
_) = Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return Fix NExprF
untranslatable
loop (App Expr s Void
None Expr s Void
_) =
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NAtom -> NExprF (Fix NExprF)
forall r. NAtom -> NExprF r
NConstant NAtom
NNull))
loop (App (Field (Union Map Text (Maybe (Expr s Void))
kts) (FieldSelection s -> Text
forall s. FieldSelection s -> Text
Dhall.Core.fieldSelectionLabel -> Text
k)) Expr s Void
v) = do
Fix NExprF
v' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
v
let e0 :: [(Text, Maybe (Fix NExprF))]
e0 = do
Text
k' <- Map Text (Maybe (Expr s Void)) -> [Text]
forall k v. Map k v -> [k]
Dhall.Map.keys Map Text (Maybe (Expr s Void))
kts
(Text, Maybe (Fix NExprF)) -> [(Text, Maybe (Fix NExprF))]
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
k', Maybe (Fix NExprF)
forall a. Maybe a
Nothing)
let e2 :: Fix NExprF
e2 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Text -> NExprF (Fix NExprF)
forall r. Text -> NExprF r
NSym Text
k)) Fix NExprF
v')
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs ([(Text, Maybe (Fix NExprF))]
-> Bool -> Maybe Text -> Params (Fix NExprF)
forall r. ParamSet r -> Bool -> Maybe Text -> Params r
ParamSet [(Text, Maybe (Fix NExprF))]
e0 Bool
False Maybe Text
forall a. Maybe a
Nothing) Fix NExprF
e2))
loop (App Expr s Void
a Expr s Void
b) = do
Fix NExprF
a' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
Fix NExprF
b' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
b
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
a' Fix NExprF
b'))
loop (Let Binding s Void
a0 Expr s Void
b0) = do
let MultiLet NonEmpty (Binding s Void)
as Expr s Void
b = Binding s Void -> Expr s Void -> MultiLet s Void
forall s a. Binding s a -> Expr s a -> MultiLet s a
Dhall.Core.multiLet Binding s Void
a0 Expr s Void
b0
NonEmpty (Binding (Fix NExprF))
as' <- NonEmpty (Binding s Void)
-> (Binding s Void -> Either CompileError (Binding (Fix NExprF)))
-> Either CompileError (NonEmpty (Binding (Fix NExprF)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for NonEmpty (Binding s Void)
as ((Binding s Void -> Either CompileError (Binding (Fix NExprF)))
-> Either CompileError (NonEmpty (Binding (Fix NExprF))))
-> (Binding s Void -> Either CompileError (Binding (Fix NExprF)))
-> Either CompileError (NonEmpty (Binding (Fix NExprF)))
forall a b. (a -> b) -> a -> b
$ \Binding s Void
a -> do
Fix NExprF
val <- Expr s Void -> Either CompileError (Fix NExprF)
loop (Expr s Void -> Either CompileError (Fix NExprF))
-> Expr s Void -> Either CompileError (Fix NExprF)
forall a b. (a -> b) -> a -> b
$ Binding s Void -> Expr s Void
forall s a. Binding s a -> Expr s a
Dhall.Core.value Binding s Void
a
Binding (Fix NExprF) -> Either CompileError (Binding (Fix NExprF))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Binding (Fix NExprF)
-> Either CompileError (Binding (Fix NExprF)))
-> Binding (Fix NExprF)
-> Either CompileError (Binding (Fix NExprF))
forall a b. (a -> b) -> a -> b
$ NAttrPath (Fix NExprF)
-> Fix NExprF -> SourcePos -> Binding (Fix NExprF)
forall r. NAttrPath r -> r -> SourcePos -> Binding r
NamedVar [Text -> NKeyName (Fix NExprF)
forall r. Text -> NKeyName r
StaticKey (Text -> NKeyName (Fix NExprF)) -> Text -> NKeyName (Fix NExprF)
forall a b. (a -> b) -> a -> b
$ Binding s Void -> Text
forall s a. Binding s a -> Text
Dhall.Core.variable Binding s Void
a] Fix NExprF
val SourcePos
Nix.nullPos
Fix NExprF
b' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
b
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix ([Binding (Fix NExprF)] -> Fix NExprF -> NExprF (Fix NExprF)
forall r. [Binding r] -> r -> NExprF r
NLet (NonEmpty (Binding (Fix NExprF)) -> [Binding (Fix NExprF)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Binding (Fix NExprF))
as') Fix NExprF
b'))
loop (Annot Expr s Void
a Expr s Void
_) = Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
loop Expr s Void
Bool = Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return Fix NExprF
untranslatable
loop (BoolLit Bool
b) = Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NAtom -> NExprF (Fix NExprF)
forall r. NAtom -> NExprF r
NConstant (Bool -> NAtom
NBool Bool
b)))
loop (BoolAnd Expr s Void
a Expr s Void
b) = do
Fix NExprF
a' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
Fix NExprF
b' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
b
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NAnd Fix NExprF
a' Fix NExprF
b'))
loop (BoolOr Expr s Void
a Expr s Void
b) = do
Fix NExprF
a' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
Fix NExprF
b' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
b
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NOr Fix NExprF
a' Fix NExprF
b'))
loop (BoolEQ Expr s Void
a Expr s Void
b) = do
Fix NExprF
a' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
Fix NExprF
b' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
b
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NEq Fix NExprF
a' Fix NExprF
b'))
loop (BoolNE Expr s Void
a Expr s Void
b) = do
Fix NExprF
a' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
Fix NExprF
b' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
b
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NNEq Fix NExprF
a' Fix NExprF
b'))
loop (BoolIf Expr s Void
a Expr s Void
b Expr s Void
c) = do
Fix NExprF
a' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
Fix NExprF
b' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
b
Fix NExprF
c' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
c
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Fix NExprF -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. r -> r -> r -> NExprF r
NIf Fix NExprF
a' Fix NExprF
b' Fix NExprF
c'))
loop Expr s Void
Natural = Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return Fix NExprF
untranslatable
loop (NaturalLit Natural
n) = Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NAtom -> NExprF (Fix NExprF)
forall r. NAtom -> NExprF r
NConstant (Integer -> NAtom
NInt (Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n))))
loop Expr s Void
NaturalFold = do
let e0 :: Fix NExprF
e0 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NMinus Fix NExprF
"n" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NAtom -> NExprF (Fix NExprF)
forall r. NAtom -> NExprF r
NConstant (Integer -> NAtom
NInt Integer
1))))
let e1 :: Fix NExprF
e1 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
"naturalFold" Fix NExprF
e0)) Fix NExprF
"t")) Fix NExprF
"succ")
let e2 :: Fix NExprF
e2 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
"succ" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
e1 Fix NExprF
"zero")))
let e3 :: Fix NExprF
e3 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NLte Fix NExprF
"n" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NAtom -> NExprF (Fix NExprF)
forall r. NAtom -> NExprF r
NConstant (Integer -> NAtom
NInt Integer
0))))
let e4 :: Fix NExprF
e4 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"succ" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"zero" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Fix NExprF -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. r -> r -> r -> NExprF r
NIf Fix NExprF
e3 Fix NExprF
"zero" Fix NExprF
e2)))))
let e5 :: Fix NExprF
e5 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"n" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"t" Fix NExprF
e4)))
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix ([Binding (Fix NExprF)] -> Fix NExprF -> NExprF (Fix NExprF)
forall r. [Binding r] -> r -> NExprF r
NLet [NAttrPath (Fix NExprF)
-> Fix NExprF -> SourcePos -> Binding (Fix NExprF)
forall r. NAttrPath r -> r -> SourcePos -> Binding r
NamedVar [Item (NAttrPath (Fix NExprF))
"naturalFold"] Fix NExprF
e5 SourcePos
Nix.nullPos] Fix NExprF
"naturalFold"))
loop Expr s Void
NaturalBuild = do
let e0 :: Fix NExprF
e0 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NPlus Fix NExprF
"n" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NAtom -> NExprF (Fix NExprF)
forall r. NAtom -> NExprF r
NConstant (Integer -> NAtom
NInt Integer
1))))
let e1 :: Fix NExprF
e1 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
"k" Fix NExprF
untranslatable)) (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"n" Fix NExprF
e0)))
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"k" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
e1 (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NAtom -> NExprF (Fix NExprF)
forall r. NAtom -> NExprF r
NConstant (Integer -> NAtom
NInt Integer
0)))))))
loop Expr s Void
NaturalIsZero = do
let e0 :: Fix NExprF
e0 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NEq Fix NExprF
"n" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NAtom -> NExprF (Fix NExprF)
forall r. NAtom -> NExprF r
NConstant (Integer -> NAtom
NInt Integer
0))))
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"n" Fix NExprF
e0))
loop Expr s Void
NaturalEven = do
let e0 :: Fix NExprF
e0 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NMinus Fix NExprF
"n" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NAtom -> NExprF (Fix NExprF)
forall r. NAtom -> NExprF r
NConstant (Integer -> NAtom
NInt Integer
2))))
let e1 :: Fix NExprF
e1 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
"naturalEven" Fix NExprF
e0)
let e2 :: Fix NExprF
e2 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NNEq Fix NExprF
"n" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NAtom -> NExprF (Fix NExprF)
forall r. NAtom -> NExprF r
NConstant (Integer -> NAtom
NInt Integer
1))))
let e3 :: Fix NExprF
e3 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NEq Fix NExprF
"n" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NAtom -> NExprF (Fix NExprF)
forall r. NAtom -> NExprF r
NConstant (Integer -> NAtom
NInt Integer
0))))
let e4 :: Fix NExprF
e4 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NOr Fix NExprF
e3 (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NAnd Fix NExprF
e2 Fix NExprF
e1)))
let e5 :: Binding (Fix NExprF)
e5 = NAttrPath (Fix NExprF)
-> Fix NExprF -> SourcePos -> Binding (Fix NExprF)
forall r. NAttrPath r -> r -> SourcePos -> Binding r
NamedVar [Item (NAttrPath (Fix NExprF))
"naturalEven"] (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"n" Fix NExprF
e4)) SourcePos
Nix.nullPos
let e6 :: Fix NExprF
e6 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NMinus (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NAtom -> NExprF (Fix NExprF)
forall r. NAtom -> NExprF r
NConstant (Integer -> NAtom
NInt Integer
0))) Fix NExprF
"n")
let e7 :: Fix NExprF
e7 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NLte Fix NExprF
"n" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NAtom -> NExprF (Fix NExprF)
forall r. NAtom -> NExprF r
NConstant (Integer -> NAtom
NInt Integer
0))))
let e8 :: Fix NExprF
e8 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"n" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
"naturalEven" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Fix NExprF -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. r -> r -> r -> NExprF r
NIf Fix NExprF
e7 Fix NExprF
e6 Fix NExprF
"n")))))
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix ([Binding (Fix NExprF)] -> Fix NExprF -> NExprF (Fix NExprF)
forall r. [Binding r] -> r -> NExprF r
NLet [Item [Binding (Fix NExprF)]
Binding (Fix NExprF)
e5] Fix NExprF
e8))
loop Expr s Void
NaturalOdd = do
let e0 :: Fix NExprF
e0 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NMinus Fix NExprF
"n" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NAtom -> NExprF (Fix NExprF)
forall r. NAtom -> NExprF r
NConstant (Integer -> NAtom
NInt Integer
2))))
let e1 :: Fix NExprF
e1 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
"naturalOdd" Fix NExprF
e0)
let e2 :: Fix NExprF
e2 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NNEq Fix NExprF
"n" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NAtom -> NExprF (Fix NExprF)
forall r. NAtom -> NExprF r
NConstant (Integer -> NAtom
NInt Integer
0))))
let e3 :: Fix NExprF
e3 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NEq Fix NExprF
"n" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NAtom -> NExprF (Fix NExprF)
forall r. NAtom -> NExprF r
NConstant (Integer -> NAtom
NInt Integer
1))))
let e4 :: Fix NExprF
e4 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NOr Fix NExprF
e3 (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NAnd Fix NExprF
e2 Fix NExprF
e1)))
let e5 :: Binding (Fix NExprF)
e5 = NAttrPath (Fix NExprF)
-> Fix NExprF -> SourcePos -> Binding (Fix NExprF)
forall r. NAttrPath r -> r -> SourcePos -> Binding r
NamedVar [Item (NAttrPath (Fix NExprF))
"naturalOdd"] (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"n" Fix NExprF
e4)) SourcePos
Nix.nullPos
let e6 :: Fix NExprF
e6 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NMinus (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NAtom -> NExprF (Fix NExprF)
forall r. NAtom -> NExprF r
NConstant (Integer -> NAtom
NInt Integer
0))) Fix NExprF
"n")
let e7 :: Fix NExprF
e7 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NLte Fix NExprF
"n" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NAtom -> NExprF (Fix NExprF)
forall r. NAtom -> NExprF r
NConstant (Integer -> NAtom
NInt Integer
0))))
let e8 :: Fix NExprF
e8 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"n" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
"naturalOdd" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Fix NExprF -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. r -> r -> r -> NExprF r
NIf Fix NExprF
e7 Fix NExprF
e6 Fix NExprF
"n")))))
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix ([Binding (Fix NExprF)] -> Fix NExprF -> NExprF (Fix NExprF)
forall r. [Binding r] -> r -> NExprF r
NLet [Item [Binding (Fix NExprF)]
Binding (Fix NExprF)
e5] Fix NExprF
e8))
loop Expr s Void
NaturalShow =
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return Fix NExprF
"toString"
loop Expr s Void
NaturalSubtract = do
let e0 :: Binding (Fix NExprF)
e0 = NAttrPath (Fix NExprF)
-> Fix NExprF -> SourcePos -> Binding (Fix NExprF)
forall r. NAttrPath r -> r -> SourcePos -> Binding r
NamedVar [Item (NAttrPath (Fix NExprF))
"z"] (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NMinus Fix NExprF
"y" Fix NExprF
"x")) SourcePos
Nix.nullPos
let e1 :: Fix NExprF
e1 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NLt Fix NExprF
"z" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NAtom -> NExprF (Fix NExprF)
forall r. NAtom -> NExprF r
NConstant (Integer -> NAtom
NInt Integer
0))))
let e2 :: Fix NExprF
e2 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NAtom -> NExprF (Fix NExprF)
forall r. NAtom -> NExprF r
NConstant (Integer -> NAtom
NInt Integer
0))
let e3 :: Fix NExprF
e3 = Fix NExprF
"z"
let e4 :: Fix NExprF
e4 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Fix NExprF -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. r -> r -> r -> NExprF r
NIf Fix NExprF
e1 Fix NExprF
e2 Fix NExprF
e3)
let e5 :: Fix NExprF
e5 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix ([Binding (Fix NExprF)] -> Fix NExprF -> NExprF (Fix NExprF)
forall r. [Binding r] -> r -> NExprF r
NLet [Item [Binding (Fix NExprF)]
Binding (Fix NExprF)
e0] Fix NExprF
e4)
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"x" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"y" Fix NExprF
e5))))
loop Expr s Void
NaturalToInteger =
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"n" Fix NExprF
"n"))
loop (NaturalPlus Expr s Void
a Expr s Void
b) = do
Fix NExprF
a' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
Fix NExprF
b' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
b
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NPlus Fix NExprF
a' Fix NExprF
b'))
loop (NaturalTimes Expr s Void
a Expr s Void
b) = do
Fix NExprF
a' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
Fix NExprF
b' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
b
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NMult Fix NExprF
a' Fix NExprF
b'))
loop Expr s Void
Integer = Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return Fix NExprF
untranslatable
loop (IntegerLit Integer
n) = Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NAtom -> NExprF (Fix NExprF)
forall r. NAtom -> NExprF r
NConstant (Integer -> NAtom
NInt (Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n))))
loop Expr s Void
IntegerClamp = do
let e0 :: Fix NExprF
e0 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NAtom -> NExprF (Fix NExprF)
forall r. NAtom -> NExprF r
NConstant (Integer -> NAtom
NInt Integer
0))
let e1 :: Fix NExprF
e1 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NLte (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NAtom -> NExprF (Fix NExprF)
forall r. NAtom -> NExprF r
NConstant (Integer -> NAtom
NInt Integer
0))) Fix NExprF
"x")
let e2 :: Fix NExprF
e2 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"x" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Fix NExprF -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. r -> r -> r -> NExprF r
NIf Fix NExprF
e1 Fix NExprF
"x" Fix NExprF
e0)))
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return Fix NExprF
e2
loop Expr s Void
IntegerNegate = do
let e0 :: Fix NExprF
e0 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NMinus (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NAtom -> NExprF (Fix NExprF)
forall r. NAtom -> NExprF r
NConstant (Integer -> NAtom
NInt Integer
0))) Fix NExprF
"x")
let e1 :: Fix NExprF
e1 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"x" Fix NExprF
e0)
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return Fix NExprF
e1
loop Expr s Void
IntegerShow = do
let e0 :: Fix NExprF
e0 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
"toString" Fix NExprF
"x")
let e1 :: Fix NExprF
e1 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NPlus (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NString (Fix NExprF) -> NExprF (Fix NExprF)
forall r. NString r -> NExprF r
NStr NString (Fix NExprF)
"+")) Fix NExprF
e0)
let e2 :: Fix NExprF
e2 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NLte (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NAtom -> NExprF (Fix NExprF)
forall r. NAtom -> NExprF r
NConstant (Integer -> NAtom
NInt Integer
0))) Fix NExprF
"x")
let e3 :: Fix NExprF
e3 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"x" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Fix NExprF -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. r -> r -> r -> NExprF r
NIf Fix NExprF
e2 Fix NExprF
e1 Fix NExprF
e0)))
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return Fix NExprF
e3
loop Expr s Void
IntegerToDouble =
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"x" Fix NExprF
"x"))
loop Expr s Void
Double = Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return Fix NExprF
untranslatable
loop (DoubleLit (DhallDouble Double
n)) = Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NAtom -> NExprF (Fix NExprF)
forall r. NAtom -> NExprF r
NConstant (Float -> NAtom
NFloat (Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
n))))
loop Expr s Void
DoubleShow =
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return Fix NExprF
"toString"
loop Expr s Void
Text = Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return Fix NExprF
untranslatable
loop (TextLit (Chunks [(Text, Expr s Void)]
abs_ Text
c)) = do
let process :: (Text, Expr s Void)
-> Either CompileError [Antiquoted Text (Fix NExprF)]
process (Text
a, Expr s Void
b) = do
Fix NExprF
b' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
b
[Antiquoted Text (Fix NExprF)]
-> Either CompileError [Antiquoted Text (Fix NExprF)]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> Antiquoted Text (Fix NExprF)
forall v r. v -> Antiquoted v r
Plain Text
a, Fix NExprF -> Antiquoted Text (Fix NExprF)
forall v r. r -> Antiquoted v r
Antiquoted Fix NExprF
b']
[[Antiquoted Text (Fix NExprF)]]
abs' <- ((Text, Expr s Void)
-> Either CompileError [Antiquoted Text (Fix NExprF)])
-> [(Text, Expr s Void)]
-> Either CompileError [[Antiquoted Text (Fix NExprF)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text, Expr s Void)
-> Either CompileError [Antiquoted Text (Fix NExprF)]
process [(Text, Expr s Void)]
abs_
let chunks :: [Antiquoted Text (Fix NExprF)]
chunks = [[Antiquoted Text (Fix NExprF)]] -> [Antiquoted Text (Fix NExprF)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Antiquoted Text (Fix NExprF)]]
abs' [Antiquoted Text (Fix NExprF)]
-> [Antiquoted Text (Fix NExprF)] -> [Antiquoted Text (Fix NExprF)]
forall a. [a] -> [a] -> [a]
++ [Text -> Antiquoted Text (Fix NExprF)
forall v r. v -> Antiquoted v r
Plain Text
c]
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NString (Fix NExprF) -> NExprF (Fix NExprF)
forall r. NString r -> NExprF r
NStr ([Antiquoted Text (Fix NExprF)] -> NString (Fix NExprF)
forall r. [Antiquoted Text r] -> NString r
DoubleQuoted [Antiquoted Text (Fix NExprF)]
chunks)))
loop (TextAppend Expr s Void
a Expr s Void
b) = do
Fix NExprF
a' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
Fix NExprF
b' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
b
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NPlus Fix NExprF
a' Fix NExprF
b'))
loop Expr s Void
TextReplace = do
let from :: Fix NExprF
from = [Fix NExprF] -> Fix NExprF
Nix.mkList [ Item [Fix NExprF]
"needle" ]
let to :: Fix NExprF
to = [Fix NExprF] -> Fix NExprF
Nix.mkList [ Item [Fix NExprF]
"replacement" ]
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return
( Params (Fix NExprF)
"needle"
Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Params (Fix NExprF)
"replacement"
Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Params (Fix NExprF)
"haystack"
Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> (Fix NExprF
"builtins" Fix NExprF -> Text -> Fix NExprF
@. Text
"replaceStrings" Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
from Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
to Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
"haystack")
)
loop Expr s Void
TextShow = do
let from :: Fix NExprF
from =
[Fix NExprF] -> Fix NExprF
Nix.mkList
[ Text -> Fix NExprF
Nix.mkStr Text
"\""
, Text -> Fix NExprF
Nix.mkStr Text
"$"
, Text -> Fix NExprF
Nix.mkStr Text
"\\"
, Text -> Fix NExprF
Nix.mkStr Text
"\n"
, Text -> Fix NExprF
Nix.mkStr Text
"\r"
, Text -> Fix NExprF
Nix.mkStr Text
"\t"
]
let to :: Fix NExprF
to =
[Fix NExprF] -> Fix NExprF
Nix.mkList
[ Text -> Fix NExprF
Nix.mkStr Text
"\\\""
, Text -> Fix NExprF
Nix.mkStr Text
"\\u0024"
, Text -> Fix NExprF
Nix.mkStr Text
"\\\\"
, Text -> Fix NExprF
Nix.mkStr Text
"\\n"
, Text -> Fix NExprF
Nix.mkStr Text
"\\r"
, Text -> Fix NExprF
Nix.mkStr Text
"\\t"
]
let replaced :: Fix NExprF
replaced = Fix NExprF
"builtins" Fix NExprF -> Text -> Fix NExprF
@. Text
"replaceStrings" Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
from Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
to Fix NExprF -> Fix NExprF -> Fix NExprF
@@ Fix NExprF
"t"
let quoted :: Fix NExprF
quoted = Text -> Fix NExprF
Nix.mkStr Text
"\"" Fix NExprF -> Fix NExprF -> Fix NExprF
$+ Fix NExprF
replaced Fix NExprF -> Fix NExprF -> Fix NExprF
$+ Text -> Fix NExprF
Nix.mkStr Text
"\""
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (Params (Fix NExprF)
"t" Params (Fix NExprF) -> Fix NExprF -> Fix NExprF
==> Fix NExprF
quoted)
loop Expr s Void
List = Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"t" Fix NExprF
untranslatable))
loop (ListAppend Expr s Void
a Expr s Void
b) = do
Fix NExprF
a' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
Fix NExprF
b' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
b
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NConcat Fix NExprF
a' Fix NExprF
b'))
loop (ListLit Maybe (Expr s Void)
_ Seq (Expr s Void)
bs) = do
[Fix NExprF]
bs' <- (Expr s Void -> Either CompileError (Fix NExprF))
-> [Expr s Void] -> Either CompileError [Fix NExprF]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr s Void -> Either CompileError (Fix NExprF)
loop (Seq (Expr s Void) -> [Expr s Void]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Expr s Void)
bs)
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix ([Fix NExprF] -> NExprF (Fix NExprF)
forall r. [r] -> NExprF r
NList [Fix NExprF]
bs'))
loop Expr s Void
ListBuild = do
let e0 :: Fix NExprF
e0 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
"k" Fix NExprF
untranslatable)
let e1 :: Fix NExprF
e1 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NConcat (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix ([Fix NExprF] -> NExprF (Fix NExprF)
forall r. [r] -> NExprF r
NList [Item [Fix NExprF]
"x"])) Fix NExprF
"xs")
let e2 :: Fix NExprF
e2 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
e0 (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"x" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"xs" Fix NExprF
e1)))))
let e3 :: Fix NExprF
e3 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"k" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
e2 (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix ([Fix NExprF] -> NExprF (Fix NExprF)
forall r. [r] -> NExprF r
NList [])))))
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"t" Fix NExprF
e3))
loop Expr s Void
ListFold = do
let e0 :: Fix NExprF
e0 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
"f" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
"cons" Fix NExprF
"y")) Fix NExprF
"ys")))
let e1 :: Fix NExprF
e1 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"f" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"y" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"ys" Fix NExprF
e0)))))
let e2 :: Fix NExprF
e2 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
"builtins.foldl'" Fix NExprF
e1)
let e3 :: Fix NExprF
e3 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
e2 (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"ys" Fix NExprF
"ys")))) Fix NExprF
"xs")
let e4 :: Fix NExprF
e4 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"xs" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"t" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"cons" Fix NExprF
e3)))))
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"t" Fix NExprF
e4))
loop Expr s Void
ListLength = Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"t" Fix NExprF
"builtins.length"))
loop Expr s Void
ListHead = do
let e0 :: Fix NExprF
e0 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
"builtins.head" Fix NExprF
"xs")
let e1 :: Fix NExprF
e1 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NEq Fix NExprF
"xs" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix ([Fix NExprF] -> NExprF (Fix NExprF)
forall r. [r] -> NExprF r
NList [])))
let e2 :: Fix NExprF
e2 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"xs" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Fix NExprF -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. r -> r -> r -> NExprF r
NIf Fix NExprF
e1 (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NAtom -> NExprF (Fix NExprF)
forall r. NAtom -> NExprF r
NConstant NAtom
NNull)) Fix NExprF
e0)))
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"t" Fix NExprF
e2))
loop Expr s Void
ListLast = do
let e0 :: Fix NExprF
e0 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
"builtins.length" Fix NExprF
"xs")
let e1 :: Fix NExprF
e1 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NMinus Fix NExprF
e0 (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NAtom -> NExprF (Fix NExprF)
forall r. NAtom -> NExprF r
NConstant (Integer -> NAtom
NInt Integer
1))))
let e2 :: Fix NExprF
e2 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
"builtins.elemAt" Fix NExprF
"xs")) Fix NExprF
e1)
let e3 :: Fix NExprF
e3 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NEq Fix NExprF
"xs" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix ([Fix NExprF] -> NExprF (Fix NExprF)
forall r. [r] -> NExprF r
NList [])))
let e4 :: Fix NExprF
e4 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"xs" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Fix NExprF -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. r -> r -> r -> NExprF r
NIf Fix NExprF
e3 (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NAtom -> NExprF (Fix NExprF)
forall r. NAtom -> NExprF r
NConstant NAtom
NNull)) Fix NExprF
e2)))
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"t" Fix NExprF
e4))
loop Expr s Void
ListIndexed = do
let e0 :: Fix NExprF
e0 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
"builtins.length" Fix NExprF
"xs")
let e1 :: Fix NExprF
e1 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
"builtins.elemAt" Fix NExprF
"xs")) Fix NExprF
"i")
let e2 :: [Binding (Fix NExprF)]
e2 =
[ NAttrPath (Fix NExprF)
-> Fix NExprF -> SourcePos -> Binding (Fix NExprF)
forall r. NAttrPath r -> r -> SourcePos -> Binding r
NamedVar [Item (NAttrPath (Fix NExprF))
"index"] Fix NExprF
"i" SourcePos
Nix.nullPos
, NAttrPath (Fix NExprF)
-> Fix NExprF -> SourcePos -> Binding (Fix NExprF)
forall r. NAttrPath r -> r -> SourcePos -> Binding r
NamedVar [Item (NAttrPath (Fix NExprF))
"value"] Fix NExprF
e1 SourcePos
Nix.nullPos
]
let e3 :: Fix NExprF
e3 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
"builtins.genList" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"i" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NRecordType -> [Binding (Fix NExprF)] -> NExprF (Fix NExprF)
forall r. NRecordType -> [Binding r] -> NExprF r
NSet NRecordType
NNonRecursive [Binding (Fix NExprF)]
e2)))))
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"t" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"xs" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
e3 Fix NExprF
e0))))))
loop Expr s Void
ListReverse = do
let e0 :: Fix NExprF
e0 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NMinus Fix NExprF
"n" Fix NExprF
"i")
let e1 :: Fix NExprF
e1 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NMinus Fix NExprF
e0 (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NAtom -> NExprF (Fix NExprF)
forall r. NAtom -> NExprF r
NConstant (Integer -> NAtom
NInt Integer
1))))
let e2 :: Fix NExprF
e2 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
"builtins.elemAt" Fix NExprF
"xs")) Fix NExprF
e1)
let e3 :: Fix NExprF
e3 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
"builtins.genList" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"i" Fix NExprF
e2)))
let e4 :: Fix NExprF
e4 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
e3 Fix NExprF
"n")
let e5 :: Fix NExprF
e5 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
"builtins.length" Fix NExprF
"xs")
let e6 :: Fix NExprF
e6 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"xs" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix ([Binding (Fix NExprF)] -> Fix NExprF -> NExprF (Fix NExprF)
forall r. [Binding r] -> r -> NExprF r
NLet [NAttrPath (Fix NExprF)
-> Fix NExprF -> SourcePos -> Binding (Fix NExprF)
forall r. NAttrPath r -> r -> SourcePos -> Binding r
NamedVar [Item (NAttrPath (Fix NExprF))
"n"] Fix NExprF
e5 SourcePos
Nix.nullPos] Fix NExprF
e4)))
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"t" Fix NExprF
e6))
loop Expr s Void
Optional = Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"t" Fix NExprF
untranslatable))
loop (Some Expr s Void
a) = Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
loop Expr s Void
None = Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NAtom -> NExprF (Fix NExprF)
forall r. NAtom -> NExprF r
NConstant NAtom
NNull))
loop (Record Map Text (RecordField s Void)
_) = Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return Fix NExprF
untranslatable
loop (RecordLit Map Text (RecordField s Void)
a) = do
Map Text (Fix NExprF)
a' <- (RecordField s Void -> Either CompileError (Fix NExprF))
-> Map Text (RecordField s Void)
-> Either CompileError (Map Text (Fix NExprF))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Expr s Void -> Either CompileError (Fix NExprF)
loop (Expr s Void -> Either CompileError (Fix NExprF))
-> (RecordField s Void -> Expr s Void)
-> RecordField s Void
-> Either CompileError (Fix NExprF)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecordField s Void -> Expr s Void
forall s a. RecordField s a -> Expr s a
Dhall.Core.recordFieldValue) Map Text (RecordField s Void)
a
let a'' :: [Binding (Fix NExprF)]
a'' = do
(Text
k, Fix NExprF
v) <- Map Text (Fix NExprF) -> [(Text, Fix NExprF)]
forall k v. Ord k => Map k v -> [(k, v)]
Dhall.Map.toList Map Text (Fix NExprF)
a'
Binding (Fix NExprF) -> [Binding (Fix NExprF)]
forall (m :: * -> *) a. Monad m => a -> m a
return (NAttrPath (Fix NExprF)
-> Fix NExprF -> SourcePos -> Binding (Fix NExprF)
forall r. NAttrPath r -> r -> SourcePos -> Binding r
NamedVar [Text -> NKeyName (Fix NExprF)
forall r. Text -> NKeyName r
StaticKey Text
k] Fix NExprF
v SourcePos
Nix.nullPos)
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NRecordType -> [Binding (Fix NExprF)] -> NExprF (Fix NExprF)
forall r. NRecordType -> [Binding r] -> NExprF r
NSet NRecordType
NNonRecursive [Binding (Fix NExprF)]
a''))
loop (Union Map Text (Maybe (Expr s Void))
_) = Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return Fix NExprF
untranslatable
loop (Combine Maybe CharacterSet
_ Maybe Text
_ Expr s Void
a Expr s Void
b) = do
Fix NExprF
a' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
Fix NExprF
b' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
b
let e0 :: Fix NExprF
e0 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
"map" Fix NExprF
"toKeyVals")) Fix NExprF
"ks")
let e1 :: Fix NExprF
e1 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
"builtins.concatLists" Fix NExprF
e0)
let e2 :: Fix NExprF
e2 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
"builtins.listToAttrs" Fix NExprF
e1)
let defL :: Fix NExprF
defL = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
"builtins.hasAttr" Fix NExprF
"k")) Fix NExprF
"kvsL")
let defR :: Fix NExprF
defR = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
"builtins.hasAttr" Fix NExprF
"k")) Fix NExprF
"kvsR")
let valL :: Fix NExprF
valL = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
"builtins.getAttr" Fix NExprF
"k")) Fix NExprF
"kvsL")
let valR :: Fix NExprF
valR = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
"builtins.getAttr" Fix NExprF
"k")) Fix NExprF
"kvsR")
let empty_ :: Fix NExprF
empty_ = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix ([Fix NExprF] -> NExprF (Fix NExprF)
forall r. [r] -> NExprF r
NList [])
let toNameValue :: Fix NExprF -> Fix NExprF
toNameValue Fix NExprF
v =
let bindings :: [Binding (Fix NExprF)]
bindings =
[ NAttrPath (Fix NExprF)
-> Fix NExprF -> SourcePos -> Binding (Fix NExprF)
forall r. NAttrPath r -> r -> SourcePos -> Binding r
NamedVar [Item (NAttrPath (Fix NExprF))
"name" ] Fix NExprF
"k" SourcePos
Nix.nullPos
, NAttrPath (Fix NExprF)
-> Fix NExprF -> SourcePos -> Binding (Fix NExprF)
forall r. NAttrPath r -> r -> SourcePos -> Binding r
NamedVar [Item (NAttrPath (Fix NExprF))
"value"] Fix NExprF
v SourcePos
Nix.nullPos
]
in NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix ([Fix NExprF] -> NExprF (Fix NExprF)
forall r. [r] -> NExprF r
NList [NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NRecordType -> [Binding (Fix NExprF)] -> NExprF (Fix NExprF)
forall r. NRecordType -> [Binding r] -> NExprF r
NSet NRecordType
NNonRecursive [Binding (Fix NExprF)]
bindings)])
let e3 :: Fix NExprF
e3 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
"combine" Fix NExprF
valL)) Fix NExprF
valR)
let e4 :: Fix NExprF
e4 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
"builtins.isAttrs" Fix NExprF
valL)
let e5 :: Fix NExprF
e5 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
"builtins.isAttrs" Fix NExprF
valR)
let e6 :: Fix NExprF
e6 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NAnd Fix NExprF
e4 Fix NExprF
e5)
let e7 :: Fix NExprF
e7 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Fix NExprF -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. r -> r -> r -> NExprF r
NIf Fix NExprF
e6 (Fix NExprF -> Fix NExprF
toNameValue Fix NExprF
e3) (Fix NExprF -> Fix NExprF
toNameValue Fix NExprF
valR))
let e8 :: Fix NExprF
e8 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Fix NExprF -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. r -> r -> r -> NExprF r
NIf Fix NExprF
defR Fix NExprF
e7 (Fix NExprF -> Fix NExprF
toNameValue Fix NExprF
valL))
let e9 :: Fix NExprF
e9 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Fix NExprF -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. r -> r -> r -> NExprF r
NIf Fix NExprF
defR (Fix NExprF -> Fix NExprF
toNameValue Fix NExprF
valR) Fix NExprF
empty_)
let toKeyVals :: Fix NExprF
toKeyVals = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"k" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Fix NExprF -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. r -> r -> r -> NExprF r
NIf Fix NExprF
defL Fix NExprF
e8 Fix NExprF
e9)))
let ksL :: Fix NExprF
ksL = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
"builtins.attrNames" Fix NExprF
"kvsL")
let ksR :: Fix NExprF
ksR = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
"builtins.attrNames" Fix NExprF
"kvsR")
let ks :: Fix NExprF
ks = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NConcat Fix NExprF
ksL Fix NExprF
ksR)
let e10 :: [Binding (Fix NExprF)]
e10 =
[ NAttrPath (Fix NExprF)
-> Fix NExprF -> SourcePos -> Binding (Fix NExprF)
forall r. NAttrPath r -> r -> SourcePos -> Binding r
NamedVar [Item (NAttrPath (Fix NExprF))
"ks" ] Fix NExprF
ks SourcePos
Nix.nullPos
, NAttrPath (Fix NExprF)
-> Fix NExprF -> SourcePos -> Binding (Fix NExprF)
forall r. NAttrPath r -> r -> SourcePos -> Binding r
NamedVar [Item (NAttrPath (Fix NExprF))
"toKeyVals"] Fix NExprF
toKeyVals SourcePos
Nix.nullPos
]
let combine :: Fix NExprF
combine = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"kvsL" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"kvsR" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix ([Binding (Fix NExprF)] -> Fix NExprF -> NExprF (Fix NExprF)
forall r. [Binding r] -> r -> NExprF r
NLet [Binding (Fix NExprF)]
e10 Fix NExprF
e2)))))
let e11 :: Fix NExprF
e11 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
"combine" Fix NExprF
a')) Fix NExprF
b')
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix ([Binding (Fix NExprF)] -> Fix NExprF -> NExprF (Fix NExprF)
forall r. [Binding r] -> r -> NExprF r
NLet [NAttrPath (Fix NExprF)
-> Fix NExprF -> SourcePos -> Binding (Fix NExprF)
forall r. NAttrPath r -> r -> SourcePos -> Binding r
NamedVar [Item (NAttrPath (Fix NExprF))
"combine"] Fix NExprF
combine SourcePos
Nix.nullPos] Fix NExprF
e11))
loop (CombineTypes Maybe CharacterSet
_ Expr s Void
_ Expr s Void
_) = Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return Fix NExprF
untranslatable
loop (Merge Expr s Void
a Expr s Void
b Maybe (Expr s Void)
_) = do
Fix NExprF
a' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
Fix NExprF
b' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
b
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
b' Fix NExprF
a'))
loop (ToMap Expr s Void
a Maybe (Expr s Void)
_) = do
Fix NExprF
a' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
let ks :: Fix NExprF
ks = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
"builtins.attrNames" Fix NExprF
"kvs")
let v :: Fix NExprF
v = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
"builtins.getAttr" Fix NExprF
"k")) Fix NExprF
"kvs")
let setBindings :: [Binding (Fix NExprF)]
setBindings =
[ NAttrPath (Fix NExprF)
-> Fix NExprF -> SourcePos -> Binding (Fix NExprF)
forall r. NAttrPath r -> r -> SourcePos -> Binding r
NamedVar [Text -> NKeyName (Fix NExprF)
forall r. Text -> NKeyName r
StaticKey Text
"mapKey"] Fix NExprF
"k" SourcePos
Nix.nullPos
, NAttrPath (Fix NExprF)
-> Fix NExprF -> SourcePos -> Binding (Fix NExprF)
forall r. NAttrPath r -> r -> SourcePos -> Binding r
NamedVar [Text -> NKeyName (Fix NExprF)
forall r. Text -> NKeyName r
StaticKey Text
"mapValue"] Fix NExprF
v SourcePos
Nix.nullPos
]
let map_ :: Fix NExprF
map_ = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
"map" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"k" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NRecordType -> [Binding (Fix NExprF)] -> NExprF (Fix NExprF)
forall r. NRecordType -> [Binding r] -> NExprF r
NSet NRecordType
NNonRecursive [Binding (Fix NExprF)]
setBindings)))))
let toMap :: Fix NExprF
toMap = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs Params (Fix NExprF)
"kvs" (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
map_ Fix NExprF
ks)))
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp Fix NExprF
toMap Fix NExprF
a'))
loop (Prefer Maybe CharacterSet
_ PreferAnnotation s Void
_ Expr s Void
b Expr s Void
c) = do
Fix NExprF
b' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
b
Fix NExprF
c' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
c
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NUpdate Fix NExprF
b' Fix NExprF
c'))
loop (RecordCompletion Expr s Void
a Expr s Void
b) =
Expr s Void -> Either CompileError (Fix NExprF)
loop (Expr s Void -> Expr s Void -> Expr s Void
forall s a. Expr s a -> Expr s a -> Expr s a
Annot (Maybe CharacterSet
-> PreferAnnotation s Void
-> Expr s Void
-> Expr s Void
-> Expr s Void
forall s a.
Maybe CharacterSet
-> PreferAnnotation s a -> Expr s a -> Expr s a -> Expr s a
Prefer Maybe CharacterSet
forall a. Monoid a => a
mempty PreferAnnotation s Void
forall s a. PreferAnnotation s a
PreferFromCompletion (Expr s Void -> FieldSelection s -> Expr s Void
forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr s Void
a FieldSelection s
forall s. FieldSelection s
def) Expr s Void
b) (Expr s Void -> FieldSelection s -> Expr s Void
forall s a. Expr s a -> FieldSelection s -> Expr s a
Field Expr s Void
a FieldSelection s
forall s. FieldSelection s
typ))
where
def :: FieldSelection s
def = Text -> FieldSelection s
forall s. Text -> FieldSelection s
Dhall.Core.makeFieldSelection Text
"default"
typ :: FieldSelection s
typ = Text -> FieldSelection s
forall s. Text -> FieldSelection s
Dhall.Core.makeFieldSelection Text
"Type"
loop (Field (Union Map Text (Maybe (Expr s Void))
kts) (FieldSelection s -> Text
forall s. FieldSelection s -> Text
Dhall.Core.fieldSelectionLabel -> Text
k)) =
case Text
-> Map Text (Maybe (Expr s Void)) -> Maybe (Maybe (Expr s Void))
forall k v. Ord k => k -> Map k v -> Maybe v
Dhall.Map.lookup Text
k Map Text (Maybe (Expr s Void))
kts of
Just ( Just Expr s Void
_ ) -> do
let e0 :: [(Text, Maybe (Fix NExprF))]
e0 = do
Text
k' <- Map Text (Maybe (Expr s Void)) -> [Text]
forall k v. Map k v -> [k]
Dhall.Map.keys Map Text (Maybe (Expr s Void))
kts
(Text, Maybe (Fix NExprF)) -> [(Text, Maybe (Fix NExprF))]
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
k', Maybe (Fix NExprF)
forall a. Maybe a
Nothing)
let e2 :: Fix NExprF
e2 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NBinaryOp -> Fix NExprF -> Fix NExprF -> NExprF (Fix NExprF)
forall r. NBinaryOp -> r -> r -> NExprF r
NBinary NBinaryOp
NApp (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Text -> NExprF (Fix NExprF)
forall r. Text -> NExprF r
NSym Text
k)) (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Text -> NExprF (Fix NExprF)
forall r. Text -> NExprF r
NSym Text
"x")))
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs (Text -> Params (Fix NExprF)
forall r. Text -> Params r
Param Text
"x") (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs ([(Text, Maybe (Fix NExprF))]
-> Bool -> Maybe Text -> Params (Fix NExprF)
forall r. ParamSet r -> Bool -> Maybe Text -> Params r
ParamSet [(Text, Maybe (Fix NExprF))]
e0 Bool
False Maybe Text
forall a. Maybe a
Nothing) Fix NExprF
e2))))
Maybe (Maybe (Expr s Void))
_ -> do
let e0 :: [(Text, Maybe (Fix NExprF))]
e0 = do
Text
k' <- Map Text (Maybe (Expr s Void)) -> [Text]
forall k v. Map k v -> [k]
Dhall.Map.keys Map Text (Maybe (Expr s Void))
kts
(Text, Maybe (Fix NExprF)) -> [(Text, Maybe (Fix NExprF))]
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
k', Maybe (Fix NExprF)
forall a. Maybe a
Nothing)
let e2 :: Fix NExprF
e2 = NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Text -> NExprF (Fix NExprF)
forall r. Text -> NExprF r
NSym Text
k)
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Params (Fix NExprF) -> Fix NExprF -> NExprF (Fix NExprF)
forall r. Params r -> r -> NExprF r
NAbs ([(Text, Maybe (Fix NExprF))]
-> Bool -> Maybe Text -> Params (Fix NExprF)
forall r. ParamSet r -> Bool -> Maybe Text -> Params r
ParamSet [(Text, Maybe (Fix NExprF))]
e0 Bool
False Maybe Text
forall a. Maybe a
Nothing) Fix NExprF
e2))
loop (Field Expr s Void
a (FieldSelection s -> Text
forall s. FieldSelection s -> Text
Dhall.Core.fieldSelectionLabel -> Text
b)) = do
Fix NExprF
a' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Fix NExprF
-> NAttrPath (Fix NExprF)
-> Maybe (Fix NExprF)
-> NExprF (Fix NExprF)
forall r. r -> NAttrPath r -> Maybe r -> NExprF r
NSelect Fix NExprF
a' [Text -> NKeyName (Fix NExprF)
forall r. Text -> NKeyName r
StaticKey Text
b] Maybe (Fix NExprF)
forall a. Maybe a
Nothing))
loop (Project Expr s Void
a (Left [Text]
b)) = do
Fix NExprF
a' <- Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
let b' :: [NKeyName (Fix NExprF)]
b' = (Text -> NKeyName (Fix NExprF))
-> [Text] -> [NKeyName (Fix NExprF)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> NKeyName (Fix NExprF)
forall r. Text -> NKeyName r
StaticKey ([Text] -> [Text]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [Text]
b)
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return (NExprF (Fix NExprF) -> Fix NExprF
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NRecordType -> [Binding (Fix NExprF)] -> NExprF (Fix NExprF)
forall r. NRecordType -> [Binding r] -> NExprF r
NSet NRecordType
NNonRecursive [Maybe (Fix NExprF)
-> [NKeyName (Fix NExprF)] -> SourcePos -> Binding (Fix NExprF)
forall r. Maybe r -> [NKeyName r] -> SourcePos -> Binding r
Inherit (Fix NExprF -> Maybe (Fix NExprF)
forall a. a -> Maybe a
Just Fix NExprF
a') [NKeyName (Fix NExprF)]
b' SourcePos
Nix.nullPos]))
loop (Project Expr s Void
_ (Right Expr s Void
_)) =
CompileError -> Either CompileError (Fix NExprF)
forall a b. a -> Either a b
Left CompileError
CannotProjectByType
loop (Assert Expr s Void
_) =
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return Fix NExprF
untranslatable
loop (Equivalent Maybe CharacterSet
_ Expr s Void
_ Expr s Void
_) =
Fix NExprF -> Either CompileError (Fix NExprF)
forall (m :: * -> *) a. Monad m => a -> m a
return Fix NExprF
untranslatable
loop a :: Expr s Void
a@With{} =
Expr s Void -> Either CompileError (Fix NExprF)
loop (Expr s Void -> Expr s Void
forall s a. Expr s a -> Expr s a
Dhall.Core.desugarWith Expr s Void
a)
loop (ImportAlt Expr s Void
a Expr s Void
_) = Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
a
loop (Note s
_ Expr s Void
b) = Expr s Void -> Either CompileError (Fix NExprF)
loop Expr s Void
b
loop (Embed Void
x) = Void -> Either CompileError (Fix NExprF)
forall a. Void -> a
absurd Void
x