Permalink
Browse files

support for a module object type

  • Loading branch information...
1 parent 5cbff42 commit 655527116873ec37f6cb4f8df246aabf46f88c1e @bjpop committed Mar 10, 2011
Showing with 58 additions and 11 deletions.
  1. +1 −0 berp.cabal
  2. +11 −10 src/Berp/Base/Object.hs
  3. +7 −1 src/Berp/Base/SemanticTypes.hs
  4. +34 −0 src/Berp/Base/StdTypes/Module.hs
  5. +5 −0 src/Berp/Base/StdTypes/Module.hs-boot
View
@@ -105,6 +105,7 @@ Library
Berp.Base.StdTypes.Generator
Berp.Base.StdTypes.Integer
Berp.Base.StdTypes.List
+ Berp.Base.StdTypes.Module
Berp.Base.StdTypes.None
Berp.Base.StdTypes.Object
Berp.Base.StdTypes.ObjectBase
@@ -44,13 +44,13 @@ import {-# SOURCE #-} Berp.Base.StdTypes.Complex (complexClass)
import {-# SOURCE #-} Berp.Base.StdTypes.Bool (boolClass)
import {-# SOURCE #-} Berp.Base.StdTypes.Tuple (tupleClass, getTupleElements)
import {-# SOURCE #-} Berp.Base.StdTypes.Function (functionClass)
-import {-# SOURCE #-} Berp.Base.StdTypes.String (stringClass)
+import {-# SOURCE #-} Berp.Base.StdTypes.String (stringClass, string)
import {-# SOURCE #-} Berp.Base.StdTypes.None (noneClass, noneIdentity)
import {-# SOURCE #-} Berp.Base.StdTypes.Dictionary (dictionaryClass)
import {-# SOURCE #-} Berp.Base.StdTypes.List (listClass, list)
import {-# SOURCE #-} Berp.Base.StdTypes.Generator (generatorClass)
import {-# SOURCE #-} Berp.Base.StdTypes.Set (setClass)
-import {-# SOURCE #-} Berp.Base.StdTypes.String (string)
+import {-# SOURCE #-} Berp.Base.StdTypes.Module (moduleClass)
-- needed for overloaded numeric literals (integers)
instance Num Object where
@@ -83,13 +83,14 @@ typeOf (None {}) = noneClass
typeOf (Dictionary {}) = dictionaryClass
typeOf (Generator {}) = generatorClass
typeOf (Set {}) = setClass
+typeOf (Module {}) = moduleClass
-- The identity of an object should never change so this can be a pure function.
identityOf :: Object -> Identity
-identityOf None = noneIdentity
+identityOf None = noneIdentity
identityOf object = object_identity object
-dictOf :: Object -> Maybe Object
+dictOf :: Object -> Maybe Object
dictOf obj@(Object {}) = Just $ object_dict obj
dictOf obj@(Type {}) = Just $ object_dict obj
dictOf obj@(Function {}) = Just $ object_dict obj
@@ -98,12 +99,12 @@ dictOf _other = Nothing
lookupAttribute :: Object -> Hashed String -> Eval Object
lookupAttribute obj ident = do
lookupResult <- lookupAttributeMaybe obj ident
- checkLookup obj ident lookupResult
+ checkLookup obj ident lookupResult
lookupSpecialAttribute :: Object -> Hashed String -> Eval Object
lookupSpecialAttribute obj ident = do
lookupResult <- lookupSpecialAttributeMaybe obj ident
- checkLookup obj ident lookupResult
+ checkLookup obj ident lookupResult
checkLookup :: Object -> Hashed String -> Maybe Object -> Eval Object
checkLookup obj (_, identStr) lookupResult =
@@ -202,11 +203,11 @@ objectEquality None None = return True
objectEquality obj1 obj2
| object_identity obj1 == object_identity obj2 = return True
| otherwise = do
- canEq <- hasAttribute specialEqName obj1
+ canEq <- hasAttribute specialEqName obj1
if canEq
then truth <$> callMethod obj1 specialEqName [obj2]
else do
- canCmp <- hasAttribute specialCmpName obj1
+ canCmp <- hasAttribute specialCmpName obj1
if canCmp
then do
cmpResult <- callMethod obj1 specialCmpName [obj2]
@@ -220,10 +221,10 @@ dir object = do
let maybeObjDict = dictOf object
let objectBasesDicts = map dictOf $ getTupleElements $ object_mro $ typeOf object
let allDicts = catMaybes (maybeObjDict : objectBasesDicts)
- let hashTables = map object_hashTable allDicts
+ let hashTables = map object_hashTable allDicts
keyObjects <- concat <$> mapM keys hashTables
let keyStrings = nub $ map (deMangle . object_string) keyObjects
- list $ map string keyStrings
+ list $ map string keyStrings
hasAttribute :: (Functor m, MonadIO m) => Hashed String -> Object -> m Bool
hasAttribute ident object = isJust <$> lookupAttributeMaybe object ident
@@ -102,7 +102,7 @@ data Object
}
| Type
{ object_identity :: !Identity
- , object_type :: Object -- type
+ , object_type :: Object -- type, is this needed? Is the type of all types == type?
, object_dict :: !Object -- dictionary
, object_bases :: !Object -- tuple
, object_constructor :: !Procedure
@@ -159,6 +159,11 @@ data Object
, object_continuation :: !(IORef (Eval Object))
, object_stack_context :: !(IORef (ControlStack -> ControlStack))
}
+ -- Modules probably need names and source information.
+ | Module
+ { object_identity :: !Identity
+ , object_dict :: !Object -- dictionary
+ }
| None
-- For debugging only
@@ -176,6 +181,7 @@ instance Show Object where
show (Set {}) = "set"
show (Generator {}) = "generator"
show obj@(Complex {}) = "complex(" ++ show (object_complex obj) ++ ")"
+ show (Module {}) = "module"
show (None {}) = "None"
-- equality instance for objects
@@ -0,0 +1,34 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module : Berp.Base.StdTypes.Module
+-- Copyright : (c) 2010 Bernie Pope
+-- License : BSD-style
+-- Maintainer : florbitous@gmail.com
+-- Stability : experimental
+-- Portability : ghc
+--
+-- Python modules.
+--
+-----------------------------------------------------------------------------
+
+module Berp.Base.StdTypes.Module (moduleClass) where
+
+-- import Berp.Base.Prims (primitive)
+import Berp.Base.Monad (constantIO)
+-- import Berp.Base.SemanticTypes (Procedure, Object (..))
+import Berp.Base.SemanticTypes (Object (..))
+-- import Berp.Base.Identity (newIdentity, Identity)
+import Berp.Base.Attributes (mkAttributes)
+-- import Berp.Base.StdNames
+import {-# SOURCE #-} Berp.Base.StdTypes.Type (newType)
+import Berp.Base.StdTypes.ObjectBase (objectBase)
+import Berp.Base.StdTypes.String (string)
+
+{-# NOINLINE moduleClass #-}
+moduleClass :: Object
+moduleClass = constantIO $ do
+ dict <- attributes
+ newType [string "module", objectBase, dict]
+
+attributes :: IO Object
+attributes = mkAttributes [ ]
@@ -0,0 +1,5 @@
+module Berp.Base.StdTypes.Module (moduleClass) where
+
+import Berp.Base.SemanticTypes (Object)
+
+moduleClass :: Object

0 comments on commit 6555271

Please sign in to comment.