← Back to branch summary

~ubuntu-branches/ubuntu/raring/agda/raring-proposed

« back to all changes in this revision

Viewing changes to src/full/Agda/Compiler/MAlonzo/Misc.hs

  • Committer: Bazaar Package Importer
  • Author(s): Iain Lane
  • Date: 2010-01-05 23:43:20 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20100105234320-6ksc0sdsfhtweknu
Tags: 2.2.6-1
http://bugs.debian.org/559197
* New upstream release 2.2.6, for headlines please see:
  http://wiki.portal.chalmers.se/agda/pmwiki.php?n=Main.Version-2-2-6
* debian/control
  + Bump standards-version to 3.8.3, no changes
  + Fix Vcs-Git to point to correct URL
  + Update build-depends for new upstream release
  + Undo arch/indep split per current pkg-haskell practice
  + Add Homepage field
* debian/copyright: Fix encoding to UTF-8 (thanks Lintian) 
* debian/README.source: Remove, no repacking so not necessary any more 
* debian/50agda.el:
  + Only load file if it exists, prevents a non-intrusive emacs warning
    where 50agda.el is left on system when package is removed. 
    (Closes: #559197). 
  + Do not load file on XEmacs — agda-mode is not compatible with XEmacs.

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/full/Agda/Compiler/MAlonzo/Misc.hs
26
26
import Agda.TypeChecking.Monad.Builtin
27
27
import Agda.Utils.FileName
28
28
import Agda.Utils.Monad
 
29
import Agda.Utils.Pretty
29
30
 
30
31
import Agda.Utils.Impossible
31
32
#include "../../undefined.h"
34
35
-- Setting up Interface before compile
35
36
--------------------------------------------------
36
37
 
37
 
mnameFromFileName :: TCM () -> FilePath -> TCM ModuleName
38
 
mnameFromFileName typecheck = (sigMName <$>) .
39
 
  (maybe (typecheck>> getSignature) (return . iSignature) =<<) .
40
 
  liftIO . readInterface . setExtension ".agdai"
41
 
 
42
 
mazCurrentMod = "MazCurrentModule"
43
 
 
44
 
setInterface :: (Interface, ClockTime) -> TCM ()
45
 
setInterface (i,t) = do modify $ \s -> s{ stImportedModules = S.empty
46
 
                                        , stHaskellImports  = iHaskellImports i
47
 
                                        }
48
 
                        (`uncurry` (i,t)) . visitModule =<< mazCurMName
49
 
 
50
 
mazCurMName :: TCM ModuleName
51
 
mazCurMName = maybe firstTime return .  L.lookup mazCurrentMod .
52
 
              L.map (\m -> (show m, m)) . keys =<< getVisitedModules
53
 
  where firstTime = concreteToAbstract_ . NewModuleQName . C.QName $
54
 
                    C.Name noRange [C.Id mazCurrentMod]
 
38
setInterface :: Interface -> TCM ()
 
39
setInterface i = modify $ \s -> s
 
40
  { stImportedModules = S.empty
 
41
  , stCurrentModule   = Just $ iModuleName i
 
42
  }
55
43
 
56
44
curIF :: TCM Interface
57
45
curIF = do
58
 
  m  <- mazCurMName
59
 
  mi <- M.lookup m <$> getVisitedModules
60
 
  case mi of
61
 
    Just (i, _) -> return i
62
 
    Nothing     -> fail $ "No such module: " ++ show m
 
46
  mName <- stCurrentModule <$> get
 
47
  case mName of
 
48
    Nothing   -> __IMPOSSIBLE__
 
49
    Just name -> do
 
50
      mm <- getVisitedModule (toTopLevelModuleName name)
 
51
      case mm of
 
52
        Nothing -> __IMPOSSIBLE__
 
53
        Just mi -> return $ miInterface mi
63
54
 
64
55
curSig :: TCM Signature
65
56
curSig = iSignature <$> curIF
100
89
tlmname m = do
101
90
  ms <- sortBy (compare `on` (length . mnameToList)) .
102
91
        L.filter (flip (isPrefixOf `on` mnameToList) m) <$>
103
 
        ((:) <$> curMName <*> (keys <$> getVisitedModules))
 
92
        L.map (iModuleName . miInterface) . M.elems <$>
 
93
        getVisitedModules
104
94
  return $ case ms of (m' : _) -> m'; _ -> mazerror$ "tlmodOf: "++show m
105
95
 
106
96
-- qualify HsName n by the module of QName q, if necessary;
143
133
mazMod :: ModuleName -> Module
144
134
mazMod = mazMod' . show
145
135
mazerror msg = error $ mazstr ++ ": " ++ msg
146
 
mazCoerce = hsVarUQ $ HsIdent "unsafeCoerce"
 
136
mazCoerce = HsVar $ Qual unsafeCoerceMod (HsIdent "unsafeCoerce")
147
137
 
148
138
-- for Runtime module: Not really used (Runtime modules has been abolished).
149
139
rtmMod  = mazMod' "Runtime"