[create routines to manipulate properties. set useful properties on certain values.
John Meacham <john@repetae.net>**20051001005742] hunk ./E/FromHs.hs 7
+import List(isPrefixOf)
hunk ./E/FromHs.hs 31
+import Info.Types
hunk ./E/FromHs.hs 188
-    method classRecord n = (methodName ,tVr ( nameToInt methodName) ty,v) where
+    method classRecord n = (methodName ,setProperty prop_METHOD (tVr ( nameToInt methodName) ty),v) where
hunk ./E/FromHs.hs 218
-    cClass classRecord =  [ tVr (nameToInt $ toName Name.Val n) (convertOneVal t) | n :>: t <- classAssumps classRecord ]
+    cClass classRecord =  [ setProperty prop_METHOD $ tVr (nameToInt $ toName Name.Val n) (convertOneVal t) | n :>: t <- classAssumps classRecord ]
hunk ./E/FromHs.hs 239
-convertDecls classHierarchy assumps dataTable hsDecls = return (concatMap cDecl hsDecls) where
+convertDecls classHierarchy assumps dataTable hsDecls = return (map anninst $ concatMap cDecl hsDecls) where
hunk ./E/FromHs.hs 242
-
+    anninst (a,b,c)
+        | "Instance@" `isPrefixOf` show a = (a,setProperty prop_INSTANCE b, c)
+        | otherwise = (a,b,c)
hunk ./E/Values.hs 15
+import Info.Types
hunk ./E/Values.hs 149
+instance HasProperties TVr where
+    setProperty prop tvr = tvrInfo_u (setProperty prop) tvr
+    unsetProperty prop tvr = tvrInfo_u (unsetProperty prop) tvr
+    getProperty prop tvr = getProperty prop (tvrInfo tvr)
hunk ./Info/Info.hs 10
+    member,
hunk ./Info/Info.hs 114
+
+member :: (Typeable a) => a -> Info -> Bool
+member x (Info s) = Map.member (createTyp x) s
hunk ./Info/Types.hs 6
+import List
hunk ./Info/Types.hs 11
+import Info.Info as Info
hunk ./Info/Types.hs 16
-    deriving(Typeable,Show,Eq,Binary,Monoid)
+    deriving(Typeable,Eq,Binary,Monoid)
hunk ./Info/Types.hs 35
+instance Show Properties where
+    showsPrec _ (Properties s) = shows (sortBy (\x y -> compare (show x) (show y)) (Set.toList s))
+
+
+-- These are set by user pragmas
hunk ./Info/Types.hs 42
+prop_ERROR_ANNOTATE = toAtom "ERROR_ANNOTATE"
+
+-- | this is set on functions which are the target of an error annotated function
+prop_ERROR_ANNOTATE_FUN = toAtom "_ERROR_ANNOTATE_FUN"
+
+-- | this is an internal flag set on instance functions
+prop_INSTANCE = toAtom "_INSTANCE"
+
+-- | this is an internal flag set on class methods to eventually be filled in
+prop_METHOD = toAtom "_METHOD"
+
+-- | whether a function is exported
+prop_EXPORTED = toAtom "_EXPORTED"
+
+
+class HasProperties a where
+    setProperty :: Atom -> a -> a
+    unsetProperty :: Atom -> a -> a
+    getProperty :: Atom -> a -> Bool
+
+instance HasProperties Properties where
+    setProperty prop (Properties x) = Properties (Set.insert prop x)
+    unsetProperty prop (Properties x) = Properties (Set.delete prop x)
+    getProperty prop (Properties x) = Set.member prop x
+
+
+instance HasProperties Info where
+    setProperty prop info = case Info.lookup info of
+        Just (Properties x) -> Info.insert (Properties $ Set.insert prop x) info
+        Nothing -> Info.insert (Properties $ Set.singleton prop) info
+    unsetProperty prop info = case Info.lookup info of
+        Just pr@(Properties x) -> case Set.delete prop x of
+                p | Set.null p -> Info.delete pr info
+                  | otherwise -> Info.insert (Properties p) info
+        Nothing -> info
+    getProperty prop info = getProperty prop (Info.fetch info :: Properties)
+
hunk ./SelfTest.hs 101
+    let x = Properties mempty
+        x' = setProperty prop_METHOD $ setProperty prop_INLINE x
+    print (x',getProperty prop_METHOD x', getProperty prop_INSTANCE x')
+    let x'' = setProperty prop_INSTANCE $ unsetProperty prop_METHOD x'
+    print (x'',getProperty prop_METHOD x'', getProperty prop_INSTANCE x'')
+
+    let x = Info.empty
+        x' = setProperty prop_METHOD $ setProperty prop_INLINE x
+    print (x',getProperty prop_METHOD x', getProperty prop_INSTANCE x')
+    let x'' = setProperty prop_INSTANCE $ unsetProperty prop_METHOD x'
+    print (x'',getProperty prop_METHOD x'', getProperty prop_INSTANCE x'')
+