{-# LANGUAGE OverloadedStrings #-}
module Funcons.Core.Values.Composite.Records.Records where
import Funcons.EDSL
import Funcons.Operations hiding (Values)
entities = []
types = typeEnvFromList
[("records",DataTypeMemberss "records" [TPVar "MIT"] [DataTypeMemberConstructor "record" [TApp "maps" [TName "ids",TName "values"]] (Just [TPVar "MIT"])])]
funcons = libFromList
[("record",StrictFuncon stepRecord),("record-select",StrictFuncon stepRecord_select),("records",StrictFuncon stepRecords)]
record_ fargs = FApp "record" (fargs)
stepRecord 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 'c'),FValue (Ascii 'o'),FValue (Ascii 'r'),FValue (Ascii 'd')])),TVar "_X1"]) env
record_select_ fargs = FApp "record-select" (fargs)
stepRecord_select fargs =
evalRules [rewrite1] []
where rewrite1 = do
let env = emptyEnv
env <- vsMatch fargs [PADT "record" [VPAnnotated (VPMetaVar "MIV") (TApp "maps" [TName "ids",TName "values"])],VPAnnotated (VPMetaVar "I") (TName "ids")] env
rewriteTermTo (TApp "lookup" [TVar "MIV",TVar "I"]) env
records_ = FApp "records"
stepRecords ts = rewriteType "records" ts