{-# LANGUAGE OverloadedStrings #-}
module Funcons.Core.Values.Composite.Records.Records where
import Funcons.EDSL
import Funcons.Operations hiding (Values,libFromList)
entities :: [a]
entities = []
types :: TypeRelation
types = [(Name, DataTypeMembers)] -> TypeRelation
typeEnvFromList
[(Name
"records",Name -> [TPattern] -> [DataTypeAltt] -> DataTypeMembers
DataTypeMemberss Name
"records" [MetaVar -> TPattern
TPVar MetaVar
"T"] [Name -> [FTerm] -> Maybe [TPattern] -> DataTypeAltt
DataTypeMemberConstructor Name
"record" [Name -> [FTerm] -> FTerm
TApp Name
"maps" [Name -> FTerm
TName Name
"identifiers",MetaVar -> FTerm
TVar MetaVar
"T"]] ([TPattern] -> Maybe [TPattern]
forall a. a -> Maybe a
Just [MetaVar -> TPattern
TPVar MetaVar
"T"])])]
funcons :: FunconLibrary
funcons = [(Name, EvalFunction)] -> FunconLibrary
libFromList
[(Name
"record",StrictFuncon -> EvalFunction
StrictFuncon StrictFuncon
stepRecord),(Name
"record-map",StrictFuncon -> EvalFunction
StrictFuncon StrictFuncon
stepRecord_map),(Name
"record-select",StrictFuncon -> EvalFunction
StrictFuncon StrictFuncon
stepRecord_select),(Name
"records",StrictFuncon -> EvalFunction
StrictFuncon StrictFuncon
stepRecords)]
record_ :: [Funcons] -> Funcons
record_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"record" ([Funcons]
fargs)
stepRecord :: StrictFuncon
stepRecord [Values]
fargs =
[Rewrite Rewritten] -> [MSOS StepRes] -> Rewrite Rewritten
evalRules [Rewrite Rewritten
rewrite1] []
where rewrite1 :: Rewrite Rewritten
rewrite1 = do
let env :: Map k a
env = Map k a
forall k a. Map k a
emptyEnv
Env
env <- [Values] -> [VPattern] -> Env -> Rewrite Env
vsMatch [Values]
fargs [MetaVar -> VPattern
VPMetaVar MetaVar
"_X1"] Env
forall k a. Map k a
env
Env
env <- SideCondition -> Env -> Rewrite Env
sideCondition (FTerm -> FTerm -> SideCondition
SCIsInSort (MetaVar -> FTerm
TVar MetaVar
"_X1") (FTerm -> SeqSortOp -> FTerm
TSortSeq (Name -> FTerm
TName Name
"values") SeqSortOp
QuestionMarkOp)) Env
env
FTerm -> Env -> Rewrite Rewritten
rewriteTermTo (Name -> [FTerm] -> FTerm
TApp Name
"datatype-value" [Funcons -> FTerm
TFuncon (Values -> Funcons
FValue (Name -> [Funcons] -> Values
forall t. Name -> [t] -> Values t
ADTVal Name
"list" [Values -> Funcons
FValue (Name -> [Funcons] -> Values
forall t. Name -> [t] -> Values t
ADTVal Name
"unicode-character" [Values -> Funcons
FValue (Integer -> Values
forall t. Integer -> Values t
Int Integer
114)]),Values -> Funcons
FValue (Name -> [Funcons] -> Values
forall t. Name -> [t] -> Values t
ADTVal Name
"unicode-character" [Values -> Funcons
FValue (Integer -> Values
forall t. Integer -> Values t
Int Integer
101)]),Values -> Funcons
FValue (Name -> [Funcons] -> Values
forall t. Name -> [t] -> Values t
ADTVal Name
"unicode-character" [Values -> Funcons
FValue (Integer -> Values
forall t. Integer -> Values t
Int Integer
99)]),Values -> Funcons
FValue (Name -> [Funcons] -> Values
forall t. Name -> [t] -> Values t
ADTVal Name
"unicode-character" [Values -> Funcons
FValue (Integer -> Values
forall t. Integer -> Values t
Int Integer
111)]),Values -> Funcons
FValue (Name -> [Funcons] -> Values
forall t. Name -> [t] -> Values t
ADTVal Name
"unicode-character" [Values -> Funcons
FValue (Integer -> Values
forall t. Integer -> Values t
Int Integer
114)]),Values -> Funcons
FValue (Name -> [Funcons] -> Values
forall t. Name -> [t] -> Values t
ADTVal Name
"unicode-character" [Values -> Funcons
FValue (Integer -> Values
forall t. Integer -> Values t
Int Integer
100)])])),MetaVar -> FTerm
TVar MetaVar
"_X1"]) Env
env
record_map_ :: [Funcons] -> Funcons
record_map_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"record-map" ([Funcons]
fargs)
stepRecord_map :: StrictFuncon
stepRecord_map [Values]
fargs =
[Rewrite Rewritten] -> [MSOS StepRes] -> Rewrite Rewritten
evalRules [Rewrite Rewritten
rewrite1] []
where rewrite1 :: Rewrite Rewritten
rewrite1 = do
let env :: Map k a
env = Map k a
forall k a. Map k a
emptyEnv
Env
env <- [Values] -> [VPattern] -> Env -> Rewrite Env
vsMatch [Values]
fargs [Name -> [VPattern] -> VPattern
PADT Name
"record" [VPattern -> FTerm -> VPattern
VPAnnotated (MetaVar -> VPattern
VPMetaVar MetaVar
"M") (Name -> [FTerm] -> FTerm
TApp Name
"maps" [FTerm -> SeqSortOp -> FTerm
TSortSeq (Name -> FTerm
TName Name
"values") SeqSortOp
QuestionMarkOp,FTerm -> SeqSortOp -> FTerm
TSortSeq (Name -> FTerm
TName Name
"values") SeqSortOp
QuestionMarkOp])]] Env
forall k a. Map k a
env
FTerm -> Env -> Rewrite Rewritten
rewriteTermTo (MetaVar -> FTerm
TVar MetaVar
"M") Env
env
record_select_ :: [Funcons] -> Funcons
record_select_ [Funcons]
fargs = Name -> [Funcons] -> Funcons
FApp Name
"record-select" ([Funcons]
fargs)
stepRecord_select :: StrictFuncon
stepRecord_select [Values]
fargs =
[Rewrite Rewritten] -> [MSOS StepRes] -> Rewrite Rewritten
evalRules [Rewrite Rewritten
rewrite1] []
where rewrite1 :: Rewrite Rewritten
rewrite1 = do
let env :: Map k a
env = Map k a
forall k a. Map k a
emptyEnv
Env
env <- [Values] -> [VPattern] -> Env -> Rewrite Env
vsMatch [Values]
fargs [VPattern -> FTerm -> VPattern
VPAnnotated (MetaVar -> VPattern
VPMetaVar MetaVar
"R") (Name -> [FTerm] -> FTerm
TApp Name
"records" [Name -> FTerm
TName Name
"values"]),VPattern -> FTerm -> VPattern
VPAnnotated (MetaVar -> VPattern
VPMetaVar MetaVar
"I") (Name -> FTerm
TName Name
"identifiers")] Env
forall k a. Map k a
env
FTerm -> Env -> Rewrite Rewritten
rewriteTermTo (Name -> [FTerm] -> FTerm
TApp Name
"map-lookup" [Name -> [FTerm] -> FTerm
TApp Name
"record-map" [MetaVar -> FTerm
TVar MetaVar
"R"],MetaVar -> FTerm
TVar MetaVar
"I"]) Env
env
records_ :: [Funcons] -> Funcons
records_ = Name -> [Funcons] -> Funcons
FApp Name
"records"
stepRecords :: StrictFuncon
stepRecords [Values]
ts = Name -> StrictFuncon
rewriteType Name
"records" [Values]
ts