summaryrefslogtreecommitdiff
path: root/compiler/GHC/Unit/Parser.hs
blob: bac6ba4bf1ead5b46edcbd727b717de6c1b301bd (plain)
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
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
-- | Parsers for unit/module identifiers
module GHC.Unit.Parser
   ( parseUnit
   , parseUnitId
   , parseHoleyModule
   , parseModSubst
   )
where

import GHC.Prelude

import GHC.Unit.Types
import GHC.Data.FastString

import qualified Text.ParserCombinators.ReadP as Parse
import Text.ParserCombinators.ReadP (ReadP, (<++))
import Data.Char (isAlphaNum)

import Language.Haskell.Syntax.Module.Name (ModuleName, parseModuleName)

parseUnit :: ReadP Unit
parseUnit = parseVirtUnitId <++ parseDefUnitId
  where
    parseVirtUnitId = do
        uid   <- parseUnitId
        insts <- parseModSubst
        return (mkVirtUnit uid insts)
    parseDefUnitId = do
        s <- parseUnitId
        return (RealUnit (Definite s))

parseUnitId :: ReadP UnitId
parseUnitId = do
   s <- Parse.munch1 (\c -> isAlphaNum c || c `elem` "-_.+")
   return (UnitId (mkFastString s))

parseHoleyModule :: ReadP Module
parseHoleyModule = parseModuleVar <++ parseModule
    where
      parseModuleVar = do
        _ <- Parse.char '<'
        modname <- parseModuleName
        _ <- Parse.char '>'
        return (Module HoleUnit modname)
      parseModule = do
        uid <- parseUnit
        _ <- Parse.char ':'
        modname <- parseModuleName
        return (Module uid modname)

parseModSubst :: ReadP [(ModuleName, Module)]
parseModSubst = Parse.between (Parse.char '[') (Parse.char ']')
      . flip Parse.sepBy (Parse.char ',')
      $ do k <- parseModuleName
           _ <- Parse.char '='
           v <- parseHoleyModule
           return (k, v)