ghc/utils/ghc-pkg/ParsePkgConfLite.y

   1 {
   2 -- This parser is based on ParsedPkgConf.y in compiler/main/
   3 -- It's supposed to do the same thing, but without depending on other GHC modules.
   4 -- The disadvantage is the less sophisticated error reporting, and it's probably
   5 -- slower because it doesn't use FastStrings.
   6
   7 module ParsePkgConfLite{- ( parsePackageConfig, parseOnePackageConfig ) -}where
   8
   9 import Package  ( PackageConfig(..), defaultPackageConfig )
  10 import Char(isSpace, isAlpha, isAlphaNum, isUpper)
  11 import List(break)
  12 }
  13
  14 %token
  15  '{'            { ITocurly }
  16  '}'            { ITccurly }
  17  '['            { ITobrack }
  18  ']'            { ITcbrack }
  19  ','            { ITcomma }
  20  '='            { ITequal }
  21  VARID          { ITvarid    $$ }
  22  CONID          { ITconid    $$ }
  23  STRING         { ITstring   $$ }
  24
  25 %name parse pkgconf
  26 %name parseOne pkg
  27 %tokentype { Token }
  28 %%
  29
  30 pkgconf :: { [ PackageConfig ] }
  31         : '[' ']'                       { [] }
  32         | '[' pkgs ']'                  { reverse $2 }
  33
  34 pkgs    :: { [ PackageConfig ] }
  35         : pkg                           { [ $1 ] }
  36         | pkgs ',' pkg                  { $3 : $1 }
  37
  38 pkg     :: { PackageConfig }
  39         : CONID '{' fields '}'          { $3 defaultPackageConfig }
  40
  41 fields  :: { PackageConfig -> PackageConfig }
  42         : field                         { \p -> $1 p }
  43         | fields ',' field              { \p -> $1 ($3 p) }
  44
  45 field   :: { PackageConfig -> PackageConfig }
  46         : VARID '=' STRING
  47                  {\p -> case $1 of
  48                    "name" -> p{name = $3}
  49                    _      -> error "unknown key in config file" }
  50
  51         | VARID '=' bool
  52                 {\p -> case $1 of {
  53                         "auto" -> p{auto = $3};
  54                         _      -> p } }
  55
  56         | VARID '=' strlist
  57                 {\p -> case $1 of
  58                         "import_dirs"     -> p{import_dirs     = $3}
  59                         "library_dirs"    -> p{library_dirs    = $3}
  60                         "hs_libraries"    -> p{hs_libraries    = $3}
  61                         "extra_libraries" -> p{extra_libraries = $3}
  62                         "include_dirs"    -> p{include_dirs    = $3}
  63                         "c_includes"      -> p{c_includes      = $3}
  64                         "package_deps"    -> p{package_deps    = $3}
  65                         "extra_ghc_opts"  -> p{extra_ghc_opts  = $3}
  66                         "extra_cc_opts"   -> p{extra_cc_opts   = $3}
  67                         "extra_ld_opts"   -> p{extra_ld_opts   = $3}
  68                         "framework_dirs"  -> p{framework_dirs  = $3}
  69                         "extra_frameworks"-> p{extra_frameworks= $3}
  70                         _other            -> p
  71                 }
  72
  73 strlist :: { [String] }
  74         : '[' ']'                       { [] }
  75         | '[' strs ']'                  { reverse $2 }
  76
  77 strs    :: { [String] }
  78         : STRING                        { [ $1 ] }
  79         | strs ',' STRING               { $3 : $1 }
  80
  81 bool    :: { Bool }
  82         : CONID                         {% case $1 of {
  83                                             "True"  -> True;
  84                                             "False" -> False;
  85                                             _       -> error ("unknown constructor in config file: " ++ $1) } }
  86 {
  87 data Token =
  88         ITocurly
  89     |   ITccurly
  90     |   ITobrack
  91     |   ITcbrack
  92     |   ITcomma
  93     |   ITequal
  94     |   ITvarid String
  95     |   ITconid String
  96     |   ITstring String
  97
  98 lexer :: String -> [Token]
  99
 100 lexer [] = []
 101 lexer ('{':cs) = ITocurly : lexer cs
 102 lexer ('}':cs) = ITccurly : lexer cs
 103 lexer ('[':cs) = ITobrack : lexer cs
 104 lexer (']':cs) = ITcbrack : lexer cs
 105 lexer (',':cs) = ITcomma : lexer cs
 106 lexer ('=':cs) = ITequal : lexer cs
 107 lexer ('"':cs) = lexString cs ""
 108 lexer (c:cs)
 109     | isSpace c = lexer cs
 110     | isAlpha c = lexID (c:cs) where
 111 lexer _ = error "Unexpected token"
 112
 113 lexID cs = (if isUpper (head cs) then ITconid else ITvarid) id : lexer rest
 114     where
 115         (id,rest) = break (\c -> c /= '_' && not (isAlphaNum c)) cs
 116
 117 lexString ('"':cs) s = ITstring (reverse s) : lexer cs
 118 lexString ('\\':c:cs) s = lexString cs (c:s)
 119 lexString (c:cs) s = lexString cs (c:s)
 120
 121 happyError _ = error "Couldn't parse package configuration."
 122
 123 parsePackageConfig :: String -> [PackageConfig]
 124 parsePackageConfig = parse . lexer
 125
 126 parseOnePackageConfig :: String -> PackageConfig
 127 parseOnePackageConfig = parseOne . lexer
 128 }