{-# LANGUAGE OverloadedStrings #-}
module Funcons.Core.Values.Abstraction.Generic.Generic where
import Funcons.EDSL
import Funcons.Operations hiding (Values)
entities = []
types = typeEnvFromList
[("abstractions",DataTypeMemberss "abstractions" [TPWildCard] [DataTypeMemberConstructor "abstraction" [TSortComputesFrom (TVar "DT") (TVar "T")] (Just [TPComputesFrom (TPVar "DT") (TPVar "T")])])]
funcons = libFromList
[("abstraction",NonStrictFuncon stepAbstraction),("closure",NonStrictFuncon stepClosure),("enact",StrictFuncon stepEnact),("abstractions",StrictFuncon stepAbstractions)]
abstraction_ fargs = FApp "abstraction" (fargs)
stepAbstraction fargs =
evalRules [rewrite1] []
where rewrite1 = do
let env = emptyEnv
env <- fsMatch fargs [PMetaVar "_X1"] env
rewriteTermTo (TApp "non-strict-datatype-value" [TFuncon (FValue (ADTVal "list" [FValue (Ascii 'a'),FValue (Ascii 'b'),FValue (Ascii 's'),FValue (Ascii 't'),FValue (Ascii 'r'),FValue (Ascii 'a'),FValue (Ascii 'c'),FValue (Ascii 't'),FValue (Ascii 'i'),FValue (Ascii 'o'),FValue (Ascii 'n')])),TVar "_X1"]) env
closure_ fargs = FApp "closure" (fargs)
stepClosure fargs =
evalRules [] [step1]
where step1 = do
let env = emptyEnv
env <- lifted_fsMatch fargs [PMetaVar "X"] env
env <- getInhPatt "environment" (VPMetaVar "Rho") env
stepTermTo (TApp "abstraction" [TApp "closed" [TApp "scope" [TVar "Rho",TVar "X"]]]) env
enact_ fargs = FApp "enact" (fargs)
stepEnact fargs =
evalRules [rewrite1] []
where rewrite1 = do
let env = emptyEnv
env <- vsMatch fargs [PADT "abstraction" [VPMetaVar "X"]] env
rewriteTermTo (TVar "X") env
abstractions_ = FApp "abstractions"
stepAbstractions ts = rewriteType "abstractions" ts