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

module Funcons.Core.Values.Composite.References.References where

import Funcons.EDSL

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

types = typeEnvFromList
    [("references",DataTypeMemberss "references" [TPVar "VT"] [DataTypeMemberConstructor "reference" [TVar "VT"] (Just [TPVar "VT"])])]

funcons = libFromList
    [("reference",StrictFuncon stepReference),("pointers",NonStrictFuncon stepPointers),("dereference",StrictFuncon stepDereference),("references",StrictFuncon stepReferences)]

reference_ fargs = FApp "reference" (fargs)
stepReference 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 'r'),FValue (Ascii 'e'),FValue (Ascii 'f'),FValue (Ascii 'e'),FValue (Ascii 'r'),FValue (Ascii 'e'),FValue (Ascii 'n'),FValue (Ascii 'c'),FValue (Ascii 'e')])),TVar "_X1"]) env

pointers_ fargs = FApp "pointers" (fargs)
stepPointers fargs =
    evalRules [rewrite1] []
    where rewrite1 = do
            let env = emptyEnv
            env <- fsMatch fargs [PMetaVar "VT"] env
            rewriteTermTo (TSortUnion (TName "unit-type") (TApp "references" [TVar "VT"])) env

dereference_ fargs = FApp "dereference" (fargs)
stepDereference fargs =
    evalRules [rewrite1,rewrite2] []
    where rewrite1 = do
            let env = emptyEnv
            env <- vsMatch fargs [PADT "reference" [VPAnnotated (VPMetaVar "DV") (TName "defined-values")]] env
            rewriteTermTo (TVar "DV") env
          rewrite2 = do
            let env = emptyEnv
            env <- vsMatch fargs [PADT "null-value" []] env
            rewriteTermTo (TName "none") env

references_ = FApp "references"
stepReferences ts = rewriteType "references" ts