{-# 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