module Berp.Base.StdTypes.Tuple (tuple, tupleClass, emptyTuple, getTupleElements) where
import Data.List (intersperse)
import Berp.Base.Monad (constantIO)
import Berp.Base.SemanticTypes (Object (..))
import Berp.Base.Prims (primitive, showObject)
import Berp.Base.Identity (newIdentity)
import Berp.Base.Attributes (mkAttributes)
import Berp.Base.StdNames
import Berp.Base.StdTypes.Type (newType)
import Berp.Base.StdTypes.ObjectBase (objectBase)
import Berp.Base.StdTypes.String (string)
emptyTuple :: Object
emptyTuple = tuple []
tuple :: [Object] -> Object
tuple elements = constantIO $ do
identity <- newIdentity
return $
Tuple
{ object_identity = identity
, object_tuple = elements
, object_length = length elements
}
tupleClass :: Object
tupleClass = constantIO $ do
dict <- attributes
newType [string "tuple", objectBase, dict]
getTupleElements :: Object -> [Object]
getTupleElements (Tuple { object_tuple = objs }) = objs
getTupleElements _other = error "bases of object is not a tuple"
attributes :: IO Object
attributes = mkAttributes
[ (eqName, eq)
, (strName, str)
]
eq :: Object
eq = error "== on tuple not defined"
str :: Object
str = primitive 1 $ \[x] -> do
strings <- mapM showObject $ object_tuple x
case strings of
[oneString] -> return $ string $ "(" ++ oneString ++ ",)"
_other -> return $ string $ "(" ++ concat (intersperse ", " strings) ++ ")"