IsGroundValue.hs

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