content: -----------------------------------------------------------------------------
  -- |
  -- Module      : Berp.Base.StdTypes.Object
  -- Copyright   : (c) 2010 Bernie Pope
  -- License     : BSD-style
  -- Maintainer  : florbitous@gmail.com
  -- Stability   : experimental
  -- Portability : ghc
  --
  -- The standard object type (the base of all types).
  --
  -----------------------------------------------------------------------------
  
  module Berp.Base.StdTypes.Object (object) where
  
  import Prelude hiding (init)
  import Berp.Base.SemanticTypes (Procedure, Object (..))
  import Berp.Base.Monad (constantIO)
  import Berp.Base.Attributes (mkAttributesList)
  import Berp.Base.StdNames
  import Berp.Base.Prims (primitive)
  import Berp.Base.Object (identityOf)
  import {-# SOURCE #-} Berp.Base.StdTypes.Type (newType)
  import {-# SOURCE #-} Berp.Base.StdTypes.Tuple (emptyTuple)
  import {-# SOURCE #-} Berp.Base.StdTypes.String (string)
  import {-# SOURCE #-} Berp.Base.StdTypes.Bool (bool)
  import {-# SOURCE #-} Berp.Base.StdTypes.None (none)
  
  {-# NOINLINE object #-}
  object :: Object
  object = constantIO $ do
     dict <- attributes
     newType [string "object", emptyTuple, dict]
  
  attributes :: IO Object
  attributes = mkAttributesList
     [ (specialStrName, primitive 1 str)
     , (specialEqName, primitive 2 eq)
     , (specialInitName, primitive 1 init)
     ]
  
  -- does nothing
  init :: Procedure
  init _ = return none
  
  eq :: Procedure
  eq (obj1:obj2:_) = return $ bool (identityOf obj1 == identityOf obj2)
  eq _other = error "equality on objects applied to wrong number of arguments"
  
  str :: Procedure
  str (x:_) =
     case x of
        Object {} -> do
           let objTypeNameStr = object_string $ object_type_name $ object_type x
           let identity = identityOf x
           return $ string $ "<" ++ objTypeNameStr ++ " object with identity " ++ show identity ++ ">"
        Type {} -> do
           let typeName = object_string $ object_type_name x
           return $ string $ "<class '" ++ typeName ++ "'>"
        Function {} -> do
           let identity = identityOf x
           return $ string $ "<function with identity " ++ show identity ++ ">"
        -- This should never happen because all other object types have a specialised
        -- str method.
        _other -> return $ string "<unknown object>"
  str _other = error "str conversion on object applied to wrong number of arguments"
  