module Berp.Base.StdTypes.Bool (bool, true, false, boolClass) where
import Prelude hiding (and, or)
import Berp.Base.Monad (constantIO)
import Berp.Base.Prims (binOp, primitive)
import Berp.Base.SemanticTypes (Object (..))
import Berp.Base.Identity (newIdentity)
import Berp.Base.Attributes (mkAttributes)
import Berp.Base.StdNames
import Berp.Base.StdTypes.Type (newType)
import Berp.Base.StdTypes.String (string)
import Berp.Base.StdTypes.ObjectBase (objectBase)
bool :: Bool -> Object
bool True = true
bool False = false
true, false :: Object
true =
constantIO $ do
identity <- newIdentity
return $ Bool { object_identity = identity, object_bool = True }
false =
constantIO $ do
identity <- newIdentity
return $ Bool { object_identity = identity, object_bool = False }
boolClass :: Object
boolClass = constantIO $ do
dict <- attributes
theType <- newType [string "bool", objectBase, dict]
return $ theType { object_constructor = \_ -> return false }
attributes :: IO Object
attributes = mkAttributes
[ (andName, and)
, (orName, or)
, (strName, str)
]
binOpBool :: (Bool -> Bool -> Bool) -> Object
binOpBool f = primitive 2 $ \[x,y] -> binOp x y object_bool f (Prelude.return . bool)
and :: Object
and = binOpBool (&&)
or :: Object
or = binOpBool (||)
str :: Object
str = primitive 1 $ \[x] -> Prelude.return $ string $ show $ object_bool x