-- GeNeRaTeD fOr: ../../CBS-beta/Funcons-beta/Computations/Abnormal/Controlling/Controlling.cbs
{-# LANGUAGE OverloadedStrings #-}

module Funcons.Core.Computations.Abnormal.Controlling.Controlling where

import Funcons.EDSL

import Funcons.Operations hiding (Values)
entities = []

types = typeEnvFromList
    [("continuations",DataTypeMemberss "continuations" [TPVar "T1",TPVar "T2"] [DataTypeMemberConstructor "continuation" [TApp "abstractions" [TVar "T2"]] (Just [TPVar "T1",TPVar "T2"])])]

funcons = libFromList
    [("continuation",StrictFuncon stepContinuation),("hole",NullaryFuncon stepHole),("resume-continuation",StrictFuncon stepResume_continuation),("control",StrictFuncon stepControl),("delimit-continuations",NonStrictFuncon stepDelimit_continuations),("continuations",StrictFuncon stepContinuations)]

continuation_ fargs = FApp "continuation" (fargs)
stepContinuation fargs =
    evalRules [rewrite1] []
    where rewrite1 = do
            let env = emptyEnv
            env <- vsMatch fargs [VPMetaVar "_X1"] env
            env <- sideCondition (SCIsInSort (TVar "_X1") (TName "values")) env
            rewriteTermTo (TApp "datatype-value" [TFuncon (FValue (ADTVal "list" [FValue (Ascii 'c'),FValue (Ascii 'o'),FValue (Ascii 'n'),FValue (Ascii 't'),FValue (Ascii 'i'),FValue (Ascii 'n'),FValue (Ascii 'u'),FValue (Ascii 'a'),FValue (Ascii 't'),FValue (Ascii 'i'),FValue (Ascii 'o'),FValue (Ascii 'n')])),TVar "_X1"]) env

hole_ = FName "hole"
stepHole = evalRules [] [step1]
    where step1 = do
            let env = emptyEnv
            env <- getControlPatt "plug-signal" (Just (VPMetaVar "V")) env
            raiseTerm "plug-signal" (TVar "V") env
            stepTermTo (TVar "V") env

resume_continuation_ fargs = FApp "resume-continuation" (fargs)
stepResume_continuation fargs =
    evalRules [] [step1]
    where step1 = do
            let env = emptyEnv
            env <- lifted_vsMatch fargs [PADT "continuation" [PADT "abstraction" [VPMetaVar "X"]],VPAnnotated (VPMetaVar "V") (TName "values")] env
            env <- getControlPatt "plug-signal" (Nothing) env
            (env,[__varplug_signal]) <- receiveSignals ["plug-signal"] (withControlTerm "plug-signal" (Just (TVar "V")) env (premise (TVar "X") (PMetaVar "X'") env))
            env <- receiveSignalPatt __varplug_signal (Just (VPMetaVar "V")) env
            stepTermTo (TVar "X'") env

control_ fargs = FApp "control" (fargs)
stepControl fargs =
    evalRules [] [step1]
    where step1 = do
            let env = emptyEnv
            env <- lifted_vsMatch fargs [VPAnnotated (VPMetaVar "F") (TApp "functions" [TApp "continuations" [TName "values",TName "values"],TName "values"])] env
            env <- getControlPatt "control-signal" (Just (VPMetaVar "F")) env
            raiseTerm "control-signal" (TVar "F") env
            stepTermTo (TName "hole") env

delimit_continuations_ fargs = FApp "delimit-continuations" (fargs)
stepDelimit_continuations fargs =
    evalRules [rewrite1] [step1,step2]
    where rewrite1 = do
            let env = emptyEnv
            env <- fsMatch fargs [PAnnotated (PMetaVar "V") (TName "values")] env
            rewriteTermTo (TVar "V") env
          step1 = do
            let env = emptyEnv
            env <- lifted_fsMatch fargs [PMetaVar "E"] env
            env <- getControlPatt "control-signal" (Nothing) env
            (env,[__varcontrol_signal]) <- receiveSignals ["control-signal"] (withControlTerm "control-signal" (Nothing) env (premise (TVar "E") (PMetaVar "E'") env))
            env <- receiveSignalPatt __varcontrol_signal (Nothing) env
            stepTermTo (TApp "delimit-continuations" [TVar "E'"]) env
          step2 = do
            let env = emptyEnv
            env <- lifted_fsMatch fargs [PMetaVar "E"] env
            env <- getControlPatt "control-signal" (Nothing) env
            (env,[__varcontrol_signal]) <- receiveSignals ["control-signal"] (withControlTerm "control-signal" (Just (TVar "F")) env (premise (TVar "E") (PMetaVar "E'") env))
            env <- receiveSignalPatt __varcontrol_signal (Just (VPMetaVar "F")) env
            stepTermTo (TApp "delimit-continuations" [TApp "apply" [TVar "F",TApp "continuation" [TApp "closure" [TVar "E'"]]]]) env

continuations_ = FApp "continuations"
stepContinuations ts = rewriteType "continuations" ts