-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Values/Abstraction/Functions/Functions.cbs
{-# LANGUAGE OverloadedStrings #-}

module Funcons.Core.Values.Abstraction.Functions.Functions where

import Funcons.EDSL

import Funcons.Operations hiding (Values,libFromList)
entities :: [a]
entities = []

types :: TypeRelation
types = [(Name, DataTypeMembers)] -> TypeRelation
typeEnvFromList
    [(Name
"functions",Name -> [TPattern] -> [DataTypeAltt] -> DataTypeMembers
DataTypeMemberss Name
"functions" [MetaVar -> TPattern
TPVar MetaVar
"T",MetaVar -> TPattern
TPVar MetaVar
"T'"] [Name -> [FTerm] -> Maybe [TPattern] -> DataTypeAltt
DataTypeMemberConstructor Name
"function" [Name -> [FTerm] -> FTerm
TApp Name
"abstractions" [FTerm -> FTerm -> FTerm
TSortComputesFrom (MetaVar -> FTerm
TVar MetaVar
"T") (MetaVar -> FTerm
TVar MetaVar
"T'")]] ([TPattern] -> Maybe [TPattern]
forall a. a -> Maybe a
Just [MetaVar -> TPattern
TPVar MetaVar
"T",MetaVar -> TPattern
TPVar MetaVar
"T'"])])]

funcons :: FunconLibrary
funcons = [(Name, EvalFunction)] -> FunconLibrary
libFromList
    [(Name
"function",StrictFuncon -> EvalFunction
StrictFuncon StrictFuncon
stepFunction),(Name
"apply",StrictFuncon -> EvalFunction
StrictFuncon StrictFuncon
stepApply),(Name
"supply",StrictFuncon -> EvalFunction
StrictFuncon StrictFuncon
stepSupply),(Name
"compose",StrictFuncon -> EvalFunction
StrictFuncon StrictFuncon
stepCompose),(Name
"uncurry",StrictFuncon -> EvalFunction
StrictFuncon StrictFuncon
stepUncurry),(Name
"curry",StrictFuncon -> EvalFunction
StrictFuncon StrictFuncon
stepCurry),(Name
"partial-apply",StrictFuncon -> EvalFunction
StrictFuncon StrictFuncon
stepPartial_apply),(Name
"functions",StrictFuncon -> EvalFunction
StrictFuncon StrictFuncon
stepFunctions)]

function_ :: [Funcons] -> Funcons
function_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"function" ([Funcons]
fargs)
stepFunction :: StrictFuncon
stepFunction [Values]
fargs =
    [Rewrite Rewritten] -> [MSOS StepRes] -> Rewrite Rewritten
evalRules [Rewrite Rewritten
rewrite1] []
    where rewrite1 :: Rewrite Rewritten
rewrite1 = do
            let env :: Map k a
env = Map k a
forall k a. Map k a
emptyEnv
            Env
env <- [Values] -> [VPattern] -> Env -> Rewrite Env
vsMatch [Values]
fargs [MetaVar -> VPattern
VPMetaVar MetaVar
"_X1"] Env
forall k a. Map k a
env
            Env
env <- SideCondition -> Env -> Rewrite Env
sideCondition (FTerm -> FTerm -> SideCondition
SCIsInSort (MetaVar -> FTerm
TVar MetaVar
"_X1") (FTerm -> SeqSortOp -> FTerm
TSortSeq (Name -> FTerm
TName Name
"values") SeqSortOp
QuestionMarkOp)) Env
env
            FTerm -> Env -> Rewrite Rewritten
rewriteTermTo (Name -> [FTerm] -> FTerm
TApp Name
"datatype-value" [Funcons -> FTerm
TFuncon (Values -> Funcons
FValue (Name -> [Funcons] -> Values
forall t. Name -> [t] -> Values t
ADTVal Name
"list" [Values -> Funcons
FValue (Name -> [Funcons] -> Values
forall t. Name -> [t] -> Values t
ADTVal Name
"unicode-character" [Values -> Funcons
FValue (Integer -> Values
forall t. Integer -> Values t
Int Integer
102)]),Values -> Funcons
FValue (Name -> [Funcons] -> Values
forall t. Name -> [t] -> Values t
ADTVal Name
"unicode-character" [Values -> Funcons
FValue (Integer -> Values
forall t. Integer -> Values t
Int Integer
117)]),Values -> Funcons
FValue (Name -> [Funcons] -> Values
forall t. Name -> [t] -> Values t
ADTVal Name
"unicode-character" [Values -> Funcons
FValue (Integer -> Values
forall t. Integer -> Values t
Int Integer
110)]),Values -> Funcons
FValue (Name -> [Funcons] -> Values
forall t. Name -> [t] -> Values t
ADTVal Name
"unicode-character" [Values -> Funcons
FValue (Integer -> Values
forall t. Integer -> Values t
Int Integer
99)]),Values -> Funcons
FValue (Name -> [Funcons] -> Values
forall t. Name -> [t] -> Values t
ADTVal Name
"unicode-character" [Values -> Funcons
FValue (Integer -> Values
forall t. Integer -> Values t
Int Integer
116)]),Values -> Funcons
FValue (Name -> [Funcons] -> Values
forall t. Name -> [t] -> Values t
ADTVal Name
"unicode-character" [Values -> Funcons
FValue (Integer -> Values
forall t. Integer -> Values t
Int Integer
105)]),Values -> Funcons
FValue (Name -> [Funcons] -> Values
forall t. Name -> [t] -> Values t
ADTVal Name
"unicode-character" [Values -> Funcons
FValue (Integer -> Values
forall t. Integer -> Values t
Int Integer
111)]),Values -> Funcons
FValue (Name -> [Funcons] -> Values
forall t. Name -> [t] -> Values t
ADTVal Name
"unicode-character" [Values -> Funcons
FValue (Integer -> Values
forall t. Integer -> Values t
Int Integer
110)])])),MetaVar -> FTerm
TVar MetaVar
"_X1"]) Env
env

apply_ :: [Funcons] -> Funcons
apply_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"apply" ([Funcons]
fargs)
stepApply :: StrictFuncon
stepApply [Values]
fargs =
    [Rewrite Rewritten] -> [MSOS StepRes] -> Rewrite Rewritten
evalRules [Rewrite Rewritten
rewrite1] []
    where rewrite1 :: Rewrite Rewritten
rewrite1 = do
            let env :: Map k a
env = Map k a
forall k a. Map k a
emptyEnv
            Env
env <- [Values] -> [VPattern] -> Env -> Rewrite Env
vsMatch [Values]
fargs [Name -> [VPattern] -> VPattern
PADT Name
"function" [Name -> [VPattern] -> VPattern
PADT Name
"abstraction" [MetaVar -> VPattern
VPMetaVar MetaVar
"X"]],VPattern -> FTerm -> VPattern
VPAnnotated (MetaVar -> VPattern
VPMetaVar MetaVar
"V") (Name -> FTerm
TName Name
"values")] Env
forall k a. Map k a
env
            FTerm -> Env -> Rewrite Rewritten
rewriteTermTo (Name -> [FTerm] -> FTerm
TApp Name
"give" [MetaVar -> FTerm
TVar MetaVar
"V",MetaVar -> FTerm
TVar MetaVar
"X"]) Env
env

supply_ :: [Funcons] -> Funcons
supply_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"supply" ([Funcons]
fargs)
stepSupply :: StrictFuncon
stepSupply [Values]
fargs =
    [Rewrite Rewritten] -> [MSOS StepRes] -> Rewrite Rewritten
evalRules [Rewrite Rewritten
rewrite1] []
    where rewrite1 :: Rewrite Rewritten
rewrite1 = do
            let env :: Map k a
env = Map k a
forall k a. Map k a
emptyEnv
            Env
env <- [Values] -> [VPattern] -> Env -> Rewrite Env
vsMatch [Values]
fargs [Name -> [VPattern] -> VPattern
PADT Name
"function" [Name -> [VPattern] -> VPattern
PADT Name
"abstraction" [MetaVar -> VPattern
VPMetaVar MetaVar
"X"]],VPattern -> FTerm -> VPattern
VPAnnotated (MetaVar -> VPattern
VPMetaVar MetaVar
"V") (Name -> FTerm
TName Name
"values")] Env
forall k a. Map k a
env
            FTerm -> Env -> Rewrite Rewritten
rewriteTermTo (Name -> [FTerm] -> FTerm
TApp Name
"thunk" [Name -> [FTerm] -> FTerm
TApp Name
"abstraction" [Name -> [FTerm] -> FTerm
TApp Name
"give" [MetaVar -> FTerm
TVar MetaVar
"V",MetaVar -> FTerm
TVar MetaVar
"X"]]]) Env
env

compose_ :: [Funcons] -> Funcons
compose_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"compose" ([Funcons]
fargs)
stepCompose :: StrictFuncon
stepCompose [Values]
fargs =
    [Rewrite Rewritten] -> [MSOS StepRes] -> Rewrite Rewritten
evalRules [Rewrite Rewritten
rewrite1] []
    where rewrite1 :: Rewrite Rewritten
rewrite1 = do
            let env :: Map k a
env = Map k a
forall k a. Map k a
emptyEnv
            Env
env <- [Values] -> [VPattern] -> Env -> Rewrite Env
vsMatch [Values]
fargs [Name -> [VPattern] -> VPattern
PADT Name
"function" [Name -> [VPattern] -> VPattern
PADT Name
"abstraction" [MetaVar -> VPattern
VPMetaVar MetaVar
"Y"]],Name -> [VPattern] -> VPattern
PADT Name
"function" [Name -> [VPattern] -> VPattern
PADT Name
"abstraction" [MetaVar -> VPattern
VPMetaVar MetaVar
"X"]]] Env
forall k a. Map k a
env
            FTerm -> Env -> Rewrite Rewritten
rewriteTermTo (Name -> [FTerm] -> FTerm
TApp Name
"function" [Name -> [FTerm] -> FTerm
TApp Name
"abstraction" [Name -> [FTerm] -> FTerm
TApp Name
"give" [MetaVar -> FTerm
TVar MetaVar
"X",MetaVar -> FTerm
TVar MetaVar
"Y"]]]) Env
env

uncurry_ :: [Funcons] -> Funcons
uncurry_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"uncurry" ([Funcons]
fargs)
stepUncurry :: StrictFuncon
stepUncurry [Values]
fargs =
    [Rewrite Rewritten] -> [MSOS StepRes] -> Rewrite Rewritten
evalRules [Rewrite Rewritten
rewrite1] []
    where rewrite1 :: Rewrite Rewritten
rewrite1 = do
            let env :: Map k a
env = Map k a
forall k a. Map k a
emptyEnv
            Env
env <- [Values] -> [VPattern] -> Env -> Rewrite Env
vsMatch [Values]
fargs [VPattern -> FTerm -> VPattern
VPAnnotated (MetaVar -> VPattern
VPMetaVar MetaVar
"F") (Name -> [FTerm] -> FTerm
TApp Name
"functions" [Name -> FTerm
TName Name
"values",Name -> [FTerm] -> FTerm
TApp Name
"functions" [Name -> FTerm
TName Name
"values",Name -> FTerm
TName Name
"values"]])] Env
forall k a. Map k a
env
            FTerm -> Env -> Rewrite Rewritten
rewriteTermTo (Name -> [FTerm] -> FTerm
TApp Name
"function" [Name -> [FTerm] -> FTerm
TApp Name
"abstraction" [Name -> [FTerm] -> FTerm
TApp Name
"apply" [Name -> [FTerm] -> FTerm
TApp Name
"apply" [MetaVar -> FTerm
TVar MetaVar
"F",Name -> [FTerm] -> FTerm
TApp Name
"checked" [Name -> [FTerm] -> FTerm
TApp Name
"index" [Funcons -> FTerm
TFuncon (Values -> Funcons
FValue (Integer -> Values
forall t. Integer -> Values t
Nat Integer
1)),Name -> [FTerm] -> FTerm
TApp Name
"tuple-elements" [Name -> FTerm
TName Name
"given"]]]],Name -> [FTerm] -> FTerm
TApp Name
"checked" [Name -> [FTerm] -> FTerm
TApp Name
"index" [Funcons -> FTerm
TFuncon (Values -> Funcons
FValue (Integer -> Values
forall t. Integer -> Values t
Nat Integer
2)),Name -> [FTerm] -> FTerm
TApp Name
"tuple-elements" [Name -> FTerm
TName Name
"given"]]]]]]) Env
env

curry_ :: [Funcons] -> Funcons
curry_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"curry" ([Funcons]
fargs)
stepCurry :: StrictFuncon
stepCurry [Values]
fargs =
    [Rewrite Rewritten] -> [MSOS StepRes] -> Rewrite Rewritten
evalRules [Rewrite Rewritten
rewrite1] []
    where rewrite1 :: Rewrite Rewritten
rewrite1 = do
            let env :: Map k a
env = Map k a
forall k a. Map k a
emptyEnv
            Env
env <- [Values] -> [VPattern] -> Env -> Rewrite Env
vsMatch [Values]
fargs [VPattern -> FTerm -> VPattern
VPAnnotated (MetaVar -> VPattern
VPMetaVar MetaVar
"F") (Name -> [FTerm] -> FTerm
TApp Name
"functions" [Name -> [FTerm] -> FTerm
TApp Name
"tuples" [Name -> FTerm
TName Name
"values",Name -> FTerm
TName Name
"values"],Name -> FTerm
TName Name
"values"])] Env
forall k a. Map k a
env
            FTerm -> Env -> Rewrite Rewritten
rewriteTermTo (Name -> [FTerm] -> FTerm
TApp Name
"function" [Name -> [FTerm] -> FTerm
TApp Name
"abstraction" [Name -> [FTerm] -> FTerm
TApp Name
"partial-apply" [MetaVar -> FTerm
TVar MetaVar
"F",Name -> FTerm
TName Name
"given"]]]) Env
env

partial_apply_ :: [Funcons] -> Funcons
partial_apply_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"partial-apply" ([Funcons]
fargs)
stepPartial_apply :: StrictFuncon
stepPartial_apply [Values]
fargs =
    [Rewrite Rewritten] -> [MSOS StepRes] -> Rewrite Rewritten
evalRules [Rewrite Rewritten
rewrite1] []
    where rewrite1 :: Rewrite Rewritten
rewrite1 = do
            let env :: Map k a
env = Map k a
forall k a. Map k a
emptyEnv
            Env
env <- [Values] -> [VPattern] -> Env -> Rewrite Env
vsMatch [Values]
fargs [VPattern -> FTerm -> VPattern
VPAnnotated (MetaVar -> VPattern
VPMetaVar MetaVar
"F") (Name -> [FTerm] -> FTerm
TApp Name
"functions" [Name -> [FTerm] -> FTerm
TApp Name
"tuples" [Name -> FTerm
TName Name
"values",Name -> FTerm
TName Name
"values"],Name -> FTerm
TName Name
"values"]),VPattern -> FTerm -> VPattern
VPAnnotated (MetaVar -> VPattern
VPMetaVar MetaVar
"V") (Name -> FTerm
TName Name
"values")] Env
forall k a. Map k a
env
            FTerm -> Env -> Rewrite Rewritten
rewriteTermTo (Name -> [FTerm] -> FTerm
TApp Name
"function" [Name -> [FTerm] -> FTerm
TApp Name
"abstraction" [Name -> [FTerm] -> FTerm
TApp Name
"apply" [MetaVar -> FTerm
TVar MetaVar
"F",Name -> [FTerm] -> FTerm
TApp Name
"tuple" [MetaVar -> FTerm
TVar MetaVar
"V",Name -> FTerm
TName Name
"given"]]]]) Env
env

functions_ :: [Funcons] -> Funcons
functions_ = Name -> [Funcons] -> Funcons
FApp Name
"functions"
stepFunctions :: StrictFuncon
stepFunctions [Values]
ts = Name -> StrictFuncon
rewriteType Name
"functions" [Values]
ts