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

module Funcons.Core.Values.Abstraction.Generic.Generic where

import Funcons.EDSL

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

types :: TypeRelation
types = [(Name, DataTypeMembers)] -> TypeRelation
typeEnvFromList
    [(Name
"abstractions",Name -> [TPattern] -> [DataTypeAltt] -> DataTypeMembers
DataTypeMemberss Name
"abstractions" [TPattern
TPWildCard] [Name -> [FTerm] -> Maybe [TPattern] -> DataTypeAltt
DataTypeMemberConstructor Name
"abstraction" [FTerm -> FTerm -> FTerm
TSortComputesFrom (MetaVar -> FTerm
TVar MetaVar
"T?") (MetaVar -> FTerm
TVar MetaVar
"T")] ([TPattern] -> Maybe [TPattern]
forall a. a -> Maybe a
Just [TPattern -> TPattern -> TPattern
TPComputesFrom (MetaVar -> TPattern
TPVar MetaVar
"T?") (MetaVar -> TPattern
TPVar MetaVar
"T")])])]

funcons :: FunconLibrary
funcons = [(Name, EvalFunction)] -> FunconLibrary
libFromList
    [(Name
"abstraction",NonStrictFuncon -> EvalFunction
NonStrictFuncon NonStrictFuncon
stepAbstraction),(Name
"closure",NonStrictFuncon -> EvalFunction
NonStrictFuncon NonStrictFuncon
stepClosure),(Name
"enact",StrictFuncon -> EvalFunction
StrictFuncon StrictFuncon
stepEnact),(Name
"abstractions",StrictFuncon -> EvalFunction
StrictFuncon StrictFuncon
stepAbstractions)]

abstraction_ :: [Funcons] -> Funcons
abstraction_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"abstraction" ([Funcons]
fargs)
stepAbstraction :: NonStrictFuncon
stepAbstraction [Funcons]
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 <- [Funcons] -> [FPattern] -> Env -> Rewrite Env
fsMatch [Funcons]
fargs [MetaVar -> FPattern
PMetaVar MetaVar
"_X1"] Env
forall k a. Map k a
env
            FTerm -> Env -> Rewrite Rewritten
rewriteTermTo (Name -> [FTerm] -> FTerm
TApp Name
"non-strict-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
97)]),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
98)]),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
115)]),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
114)]),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
97)]),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

closure_ :: [Funcons] -> Funcons
closure_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"closure" ([Funcons]
fargs)
stepClosure :: NonStrictFuncon
stepClosure [Funcons]
fargs =
    [Rewrite Rewritten] -> [MSOS StepRes] -> Rewrite Rewritten
evalRules [] [MSOS StepRes
step1]
    where step1 :: MSOS StepRes
step1 = do
            let env :: Map k a
env = Map k a
forall k a. Map k a
emptyEnv
            Env
env <- [Funcons] -> [FPattern] -> Env -> MSOS Env
lifted_fsMatch [Funcons]
fargs [MetaVar -> FPattern
PMetaVar MetaVar
"X"] Env
forall k a. Map k a
env
            Env
env <- Name -> [VPattern] -> Env -> MSOS Env
getInhPatt Name
"environment" [MetaVar -> VPattern
VPMetaVar MetaVar
"Rho"] Env
env
            FTerm -> Env -> MSOS StepRes
stepTermTo (Name -> [FTerm] -> FTerm
TApp Name
"abstraction" [Name -> [FTerm] -> FTerm
TApp Name
"closed" [Name -> [FTerm] -> FTerm
TApp Name
"scope" [MetaVar -> FTerm
TVar MetaVar
"Rho",MetaVar -> FTerm
TVar MetaVar
"X"]]]) Env
env

enact_ :: [Funcons] -> Funcons
enact_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"enact" ([Funcons]
fargs)
stepEnact :: StrictFuncon
stepEnact [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
"abstraction" [MetaVar -> VPattern
VPMetaVar MetaVar
"X"]] Env
forall k a. Map k a
env
            FTerm -> Env -> Rewrite Rewritten
rewriteTermTo (MetaVar -> FTerm
TVar MetaVar
"X") Env
env

abstractions_ :: [Funcons] -> Funcons
abstractions_ = Name -> [Funcons] -> Funcons
FApp Name
"abstractions"
stepAbstractions :: StrictFuncon
stepAbstractions [Values]
ts = Name -> StrictFuncon
rewriteType Name
"abstractions" [Values]
ts