-- GeNeRaTeD fOr: ../../CBS/Funcons/Abstractions/is-ground-value.aterm {-# LANGUAGE OverloadedStrings #-} module Funcons.Core.Abstractions.IsGroundValue where import Funcons.EDSL entities = [] types = typeEnvFromList [] funcons = libFromList [("is-ground-value",StrictFuncon stepIs_ground_value)] -- | -- A ground-value is any (potentially composite) value that -- does not contain thunks anywhere within it. is_ground_value_ fargs = FApp "is-ground-value" (FTuple fargs) stepIs_ground_value fargs = evalRules [rewrite1,rewrite2,rewrite3,rewrite4,rewrite5,rewrite6,rewrite7,rewrite8,rewrite9,rewrite10] [] where rewrite1 = do let env = emptyEnv env <- vsMatch fargs [VPMetaVar "V"] env env <- sideCondition (SCNotInSort (TVar "V") (TApp "thunks" (TTuple [TSortComputes (TName "values")]))) env env <- sideCondition (SCNotInSort (TVar "V") (TName "algebraic-datatypes")) env env <- sideCondition (SCNotInSort (TVar "V") (TApp "lists" (TTuple [TName "values"]))) env env <- sideCondition (SCNotInSort (TVar "V") (TApp "maps" (TTuple [TName "values",TName "values"]))) env env <- sideCondition (SCNotInSort (TVar "V") (TApp "multisets" (TTuple [TName "values"]))) env env <- sideCondition (SCNotInSort (TVar "V") (TApp "sets" (TTuple [TName "values"]))) env env <- sideCondition (SCNotInSort (TVar "V") (TApp "tuples" (TTuple [TName "values",TSortSeq (TName "values") PlusOp]))) env env <- sideCondition (SCNotInSort (TVar "V") (TApp "vectors" (TTuple [TName "values"]))) env rewriteTo (FName "true") rewrite2 = do let env = emptyEnv env <- vsMatch fargs [VPAnnotated (VPWildCard) (TApp "thunks" (TTuple [TSortComputes (TName "values")]))] env rewriteTo (FName "false") rewrite3 = do let env = emptyEnv env <- vsMatch fargs [VPAnnotated (VPMetaVar "A") (TName "algebraic-datatypes")] env rewriteTermTo (TApp "is-ground-value" (TTuple [TApp "algebraic-datatype-value" (TTuple [TVar "A"])])) env rewrite4 = do let env = emptyEnv env <- vsMatch fargs [PList []] env rewriteTo (FName "true") rewrite5 = do let env = emptyEnv env <- vsMatch fargs [PList [VPMetaVar "V",VPSeqVar "V*" StarOp]] env rewriteTermTo (TApp "and" (TTuple [TApp "is-ground-value" (TTuple [TVar "V"]),TApp "is-ground-value" (TList [TVar "V*"])])) env rewrite6 = do let env = emptyEnv env <- vsMatch fargs [VPAnnotated (VPMetaVar "M") (TApp "maps" (TTuple [TName "values",TName "values"]))] env rewriteTermTo (TApp "is-ground-value" (TTuple [TApp "map-to-list" (TTuple [TVar "M"])])) env rewrite7 = do let env = emptyEnv env <- vsMatch fargs [VPAnnotated (VPMetaVar "M") (TApp "multisets" (TTuple [TName "values"]))] env rewriteTermTo (TApp "is-ground-value" (TTuple [TApp "multiset-to-set" (TTuple [TVar "M"])])) env rewrite8 = do let env = emptyEnv env <- vsMatch fargs [VPAnnotated (VPMetaVar "S") (TApp "sets" (TTuple [TName "values"]))] env rewriteTermTo (TApp "is-ground-value" (TTuple [TApp "set-to-list" (TTuple [TVar "S"])])) env rewrite9 = do let env = emptyEnv env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TName "values"),VPAnnotated (VPSeqVar "V+" PlusOp) (TName "values")] env rewriteTermTo (TApp "and" (TTuple [TApp "is-ground-value" (TTuple [TVar "V"]),TApp "is-ground-value" (TTuple [TVar "V+"])])) env rewrite10 = do let env = emptyEnv env <- vsMatch fargs [VPAnnotated (VPMetaVar "V") (TApp "vectors" (TTuple [TName "values"]))] env rewriteTermTo (TApp "is-ground-value" (TTuple [TApp "vector-to-list" (TTuple [TVar "V"])])) env