Changes between Version 12 and Version 13 of TemplateHaskell/Annotations


Ignore:
Timestamp:
Oct 22, 2013 3:51:08 PM (6 months ago)
Author:
errge
Comment:

--

Legend:

Unmodified
Added
Removed
Modified
  • TemplateHaskell/Annotations

    v12 v13  
    7979Template haskell is a corner-case, where this orphan logic is not clever enough and therefore reify doesn't see some of the instances that are under the current module in the dependency tree.  Even more so, if the class instance is in a separate package (and not marked orphan, as is the case in HFlags), then it's not seen either in one-shot or in batch mode.  Therefore HFlags can't gather all the flags in `$initHFlags`.  There is a fix to this as a patch in #8426, but that needs more discussion. 
    8080 
    81 An easier way is to implement #1480, module reification.  If we can get the import list of every module, then HFlags can walk the tree of imports itself and gather all the flags.  The nice in this is that the compiler only needs very basic and simple support, and then the logic of traversal can be implemented in HFlags, not in the compiler.solutions, or object to both.** 
     81An easier way is to implement #1480, module reification.  If we can get the import list of every module, then HFlags can walk the tree of imports itself and gather all the flags.  The nice in this is that the compiler only needs very basic and simple support, and then the logic of traversal can be implemented in HFlags, not in the compiler. 
    8282 
    8383------------------------------- 
     
    9797== Example == 
    9898 
    99 Here is (a sketch of) how we can use these new facilities to implement `defineFlag` and `$initHFlags` in the above example. 
    100  
    101 ...fill in... 
     99Here is a minimalistic implementation showing how we can use these new facilities to implement `defineFlag` and `$initHFlags` in the above example. 
     100 
     101  - `HFlags.hs`: 
     102{{{#!haskell 
     103{-# LANGUAGE TemplateHaskell #-} 
     104{-# LANGUAGE DeriveDataTypeable #-} 
     105 
     106module HFlags where 
     107 
     108import Control.Applicative 
     109import Data.Data 
     110import qualified Data.Set as Set 
     111import Language.Haskell.TH 
     112import Language.Haskell.TH.Syntax 
     113 
     114-- in the real world, this is more complex, of course 
     115data FlagData = FlagData String deriving (Show, Data, Typeable) 
     116instance Lift FlagData where 
     117  lift (FlagData s) = [| FlagData s |] 
     118 
     119defineFlag :: FlagData -> DecsQ 
     120defineFlag str = do 
     121  (:[]) <$> pragAnnD ModuleAnnotation (lift str) 
     122 
     123traverseAnnotations :: Q [FlagData] 
     124traverseAnnotations = do 
     125  ModuleInfo children <- reifyModule =<< thisModule 
     126  go children Set.empty [] 
     127  where 
     128    go []     _visited acc = return acc 
     129    go (x:xs) visited  acc | x `Set.member` visited = go xs visited acc 
     130                           | otherwise = do 
     131                             ModuleInfo newMods <- reifyModule x 
     132                             newAnns <- reifyAnnotations $ AnnLookupModule x 
     133                             go (newMods ++ xs) (x `Set.insert` visited) (newAnns ++ acc) 
     134 
     135initHFlags :: ExpQ 
     136initHFlags = do 
     137  anns <- traverseAnnotations 
     138  [| print anns |] -- in the real world do something here, like generating --help 
     139}}} 
     140  - `A.hs`: 
     141{{{#!haskell 
     142{-# LANGUAGE TemplateHaskell #-} 
     143 
     144module A where 
     145 
     146import HFlags 
     147 
     148defineFlag (FlagData "A module is here!") 
     149}}} 
     150  - `B.hs`: 
     151{{{#!haskell 
     152{-# LANGUAGE TemplateHaskell #-} 
     153 
     154module B where 
     155 
     156import A 
     157import HFlags 
     158 
     159defineFlag (FlagData "B module is here!") 
     160}}} 
     161  - `Main.hs`: 
     162{{{#!haskell 
     163{-# LANGUAGE TemplateHaskell #-} 
     164 
     165import B 
     166import HFlags 
     167 
     168main = do 
     169  $initHFlags 
     170}}} 
     171  - `build.sh`: 
     172{{{ 
     173#!/bin/sh 
     174 
     175set -e 
     176 
     177rm -f *.o *.hi Main 
     178 
     179GHC="/home/errge/tmp/ghc/inplace/bin/ghc-stage2 -v0 " 
     180 
     181$GHC -c HFlags.hs 
     182$GHC -c A.hs 
     183$GHC -c B.hs 
     184$GHC -c Main.hs 
     185$GHC --make Main 
     186}}} 
     187  - result: 
     188{{{ 
     189errge@curry:~/tmp/sketch $ ./build.sh && ./Main 
     190[FlagData "A module is here!",FlagData "B module is here!"] 
     191}}} 
     192 
     193In spite of only importing B from Main, we see the annotations from A, this was our goal. 
    102194 
    103195---------------------------