{-# LANGUAGE OverloadedStrings #-}

module Funcons.Operations.NonGroundValues where

import Prelude hiding (non_grounded)
import Funcons.Operations.Internal

library :: (HasValues t, Eq t) => Library t
library :: Library t
library = [(OP, ValueOp t)] -> Library t
forall t. [(OP, ValueOp t)] -> Library t
libFromList [
    (OP
"non-grounded", UnaryExpr t -> ValueOp t
forall t. UnaryExpr t -> ValueOp t
UnaryExpr UnaryExpr t
forall t. HasValues t => OpExpr t -> OpExpr t
non_grounded)
  , (OP
"non-grounded-values", NullaryExpr t -> ValueOp t
forall t. NullaryExpr t -> ValueOp t
NullaryExpr NullaryExpr t
forall t. HasValues t => OpExpr t
non_grounded_values)
  ]

non_grounded_ :: HasValues t => [OpExpr t] -> OpExpr t
non_grounded_ :: [OpExpr t] -> OpExpr t
non_grounded_ = UnaryExpr t -> [OpExpr t] -> OpExpr t
forall t. UnaryExpr t -> [OpExpr t] -> OpExpr t
unaryOp UnaryExpr t
forall t. HasValues t => OpExpr t -> OpExpr t
non_grounded 
non_grounded :: HasValues t => OpExpr t -> OpExpr t
non_grounded :: OpExpr t -> OpExpr t
non_grounded = OP -> UnaryVOp t -> OpExpr t -> OpExpr t
forall t. HasValues t => OP -> UnaryVOp t -> OpExpr t -> OpExpr t
vUnaryOp OP
"non-grounded" (t -> Result t
forall t. t -> Result t
Normal (t -> Result t) -> (Values t -> t) -> UnaryVOp t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Values t -> t
forall t. HasValues t => Values t -> t
inject (Values t -> t) -> (Values t -> Values t) -> Values t -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> [t] -> Values t
forall t. Name -> [t] -> Values t
ADTVal Name
"non-grounded" ([t] -> Values t) -> (Values t -> [t]) -> Values t -> Values t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t -> [t] -> [t]
forall a. a -> [a] -> [a]
:[]) (t -> [t]) -> (Values t -> t) -> Values t -> [t]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Values t -> t
forall t. HasValues t => Values t -> t
inject) 

non_grounded_values_ :: HasValues t => [OpExpr t] -> OpExpr t
non_grounded_values_ :: [OpExpr t] -> OpExpr t
non_grounded_values_ = OpExpr t -> [OpExpr t] -> OpExpr t
forall t. NullaryExpr t -> [NullaryExpr t] -> NullaryExpr t
nullaryOp OpExpr t
forall t. HasValues t => OpExpr t
non_grounded_values 
non_grounded_values :: HasValues t => OpExpr t
non_grounded_values :: OpExpr t
non_grounded_values = OP -> NullaryVOp t -> OpExpr t
forall t. OP -> NullaryVOp t -> OpExpr t
vNullaryOp OP
"non-grounded-values" 
  (t -> NullaryVOp t
forall t. t -> Result t
Normal (t -> NullaryVOp t) -> t -> NullaryVOp t
forall a b. (a -> b) -> a -> b
$ Types t -> t
forall t. HasTypes t => Types t -> t
injectT (Types t -> t) -> Types t -> t
forall a b. (a -> b) -> a -> b
$ Name -> [t] -> Types t
forall t. Name -> [t] -> Types t
ADT Name
"non-grounded-values" [])

{-
-- This function differs from Funcons.Operations.Values.isGround
-- and assumes that non_grounded<> is the only non-ground value constructor
isGround :: Values t -> Bool
isGround (ADTVal "non-grounded" _) = False
isGround v = True
-}