summaryrefslogtreecommitdiffstats
path: root/lib/Phi/X11/Atoms.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Phi/X11/Atoms.hs')
-rw-r--r--lib/Phi/X11/Atoms.hs13
1 files changed, 9 insertions, 4 deletions
diff --git a/lib/Phi/X11/Atoms.hs b/lib/Phi/X11/Atoms.hs
index 38f8f3c..acbae64 100644
--- a/lib/Phi/X11/Atoms.hs
+++ b/lib/Phi/X11/Atoms.hs
@@ -12,7 +12,7 @@ import Phi.X11.AtomList
$(let atomsName = mkName "Atoms"
- atomNames = map (\atom -> (atom, mkName ("atom" ++ atom))) atoms
+ atomNames = map (\atom -> (atom, mkName ("atom" ++ atom))) $ atoms ++ (map fst specialAtoms)
fields = map (\(_, name) -> (name, IsStrict, ConT ''Atom)) atomNames
in return [DataD [] atomsName [] [RecC atomsName fields] []]
)
@@ -20,12 +20,17 @@ $(let atomsName = mkName "Atoms"
initAtoms :: Display -> IO Atoms
initAtoms display =
$(do
- atomNames <- mapM (\atom -> do
+ normalAtomNames <- mapM (\atom -> do
varName <- newName ('_':atom)
- return (atom, mkName ("atom" ++ atom), varName)
+ return ([|const atom|], mkName ("atom" ++ atom), varName)
) atoms
+ specialAtomNames <- mapM (\(name, atomgen) -> do
+ varName <- newName ('_':name)
+ return (atomgen, mkName ("atom" ++ name), varName)
+ ) specialAtoms
+ let atomNames = normalAtomNames ++ specialAtomNames
atomInitializers <- forM atomNames $
- \(atom, _, varName) -> liftM (BindS (VarP varName)) [| internAtom display atom False |]
+ \(atomgen, _, varName) -> liftM (BindS (VarP varName)) [| internAtom display ($atomgen display) False |]
let atomFieldExps = map (\(_, atomName, varName) -> (atomName, VarE varName)) atomNames
atomsName = mkName "Atoms"