-
Notifications
You must be signed in to change notification settings - Fork 0
/
Attributes.hs
42 lines (34 loc) · 1.31 KB
/
Attributes.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
-- Attribute translation for atomic all nighters.
-- Author: Ben Blum <bblum@andrew.cmu.edu>
module Attributes (attrToAnnotation,attrIsAnnotation) where
import Language.C.Data
import Language.C.Syntax.AST
import Language.C.Syntax.Constants
import Rules
stringToEffect :: String -> Maybe Effect
stringToEffect s =
case s of
"no_change" -> Just $ IncDec 0
"exit_nested" -> Just $ IncDec (-1)
"enter_nested" -> Just $ IncDec 1
"force_enable" -> Just $ Enable
"force_disable" -> Just $ Disable
_ -> Nothing
stringToRule :: String -> Maybe Rule
stringToRule s =
case s of
"might_sleep" -> Just $ Rule $ Nested 0
"nested_one" -> Just $ Rule $ Nested 1
"wont_sleep" -> Just $ Rule Infinity
_ -> Nothing
attrToAnnotation :: [CExpr] -> Maybe Annotation
attrToAnnotation [x@(CConst (CStrConst _ nobe))] = -- implicit no_change allowed
attrToAnnotation [x, CConst $ CStrConst (cString "no_change") nobe]
attrToAnnotation [CConst (CStrConst s1 _), CConst (CStrConst s2 _)] =
let (rs,es) = (getCString s1, getCString s2)
in do r <- stringToRule rs
e <- stringToEffect es
return $ Annotation (r,e)
attrToAnnotation _ = Nothing
attrIsAnnotation :: Ident -> Bool
attrIsAnnotation name = identToString name == "atomic_all_nighters"