CompilerOpts.hs 8.99 KB
Newer Older
Björn Peemöller 's avatar
Björn Peemöller committed
1
2
3
4
5
6
7
{- |
    Module      :  $Header$
    Description :  Compiler options
    Copyright   :  (c) 2005, Martin Engelke (men@informatik.uni-kiel.de)
                       2007, Sebastian Fischer (sebf@informatik.uni-kiel.de)
                       2011, Björn Peemöller (bjp@informatik.uni-kiel.de)
    License     :  OtherLicense
8

Björn Peemöller 's avatar
Björn Peemöller committed
9
10
11
12
13
14
    Maintainer  :  bjp@informatik.uni-kiel.de
    Stability   :  experimental
    Portability :  portable

    This module defines data structures containing options for the
    compilation of Curry programs.
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
-}
module CompilerOpts
  ( Options (..), Verbosity (..), TargetType (..), Extension (..)
  , DumpLevel (..), defaultOptions, compilerOpts, usage
  ) where

import Data.List (nub)
import Data.Maybe (isJust)
import System.Console.GetOpt
import System.Environment (getArgs, getProgName)

import Curry.Files.Filenames (currySubdir)

-- |Data type for recording compiler options
data Options = Options
  -- general
  { optHelp        :: Bool           -- ^ show help
  , optVersion     :: Bool           -- ^ show the version
  , optHtml        :: Bool           -- ^ generate Html code
  , optVerbosity   :: Verbosity      -- ^ verbosity level
  -- compilation
  , optForce       :: Bool           -- ^ force compilation
  , optImportPaths :: [FilePath]     -- ^ directories for imports
  , optOutput      :: Maybe FilePath -- ^ name of output file
39
  , optUseSubdir   :: Bool           -- ^ use subdir for output?
Björn Peemöller 's avatar
Björn Peemöller committed
40
41
42
  , optInterface   :: Bool           -- ^ create an interface file
  , optWarn        :: Bool           -- ^ show warnings
  , optOverlapWarn :: Bool           -- ^ show "overlap" warnings
43
  , optTargetTypes :: [TargetType]   -- ^ what to generate
Björn Peemöller 's avatar
Björn Peemöller committed
44
  , optExtensions  :: [Extension]    -- ^ enabled language extensions
Björn Peemöller 's avatar
Björn Peemöller committed
45
  , optDumps       :: [DumpLevel]    -- ^ dump levels
Björn Peemöller 's avatar
Björn Peemöller committed
46
  }
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66

-- | Default compiler options
defaultOptions :: Options
defaultOptions = Options
  { optHelp        = False
  , optVersion     = False
  , optHtml        = False
  , optVerbosity   = Verbose
  , optForce       = False
  , optImportPaths = []
  , optOutput      = Nothing
  , optUseSubdir   = True
  , optInterface   = True
  , optWarn        = True
  , optOverlapWarn = True
  , optTargetTypes = []
  , optExtensions  = []
  , optDumps       = []
  }

Björn Peemöller 's avatar
Björn Peemöller committed
67
-- |Type of the target file
68
data TargetType
Björn Peemöller 's avatar
Björn Peemöller committed
69
70
71
72
73
74
  = Parsed                -- ^ Parsed source code
  | FlatCurry             -- ^ FlatCurry
  | ExtendedFlatCurry     -- ^ Extended FlatCurry
  | FlatXml               -- ^ FlatCurry as XML
  | AbstractCurry         -- ^ AbstractCurry
  | UntypedAbstractCurry  -- ^ UntypedAbstractCurry
75
76
    deriving Eq

77
-- |Data type representing the verbosity level
78
79
80
81
82
data Verbosity
  = Quiet
  | Verbose
    deriving Eq

83
-- |Classifies a number as a 'Verbosity'
84
85
86
87
88
89
classifyVerbosity :: String -> Verbosity
classifyVerbosity "0" = Quiet
classifyVerbosity _   = Verbose

-- |Data type for representing code dumps
data DumpLevel
Björn Peemöller 's avatar
Björn Peemöller committed
90
91
92
93
94
  = DumpRenamed      -- ^ dump source  after renaming
  | DumpTypes        -- ^ dump types   after typechecking
  | DumpDesugared    -- ^ dump source  after desugaring
  | DumpSimplified   -- ^ dump source  after simplification
  | DumpLifted       -- ^ dump source  after lambda-lifting
95
  | DumpIL           -- ^ dump IL code after translation
Björn Peemöller 's avatar
Björn Peemöller committed
96
  | DumpCase         -- ^ dump IL code after case completion
97
98
    deriving (Eq, Bounded, Enum, Show)

99
-- |All available 'DumpLevel's
100
101
102
103
104
dumpAll :: [DumpLevel]
dumpAll = [minBound .. maxBound]

-- |Data type representing language extensions
data Extension
Björn Peemöller 's avatar
Björn Peemöller committed
105
106
  = Records
  | FunctionalPatterns
107
  | AnonymousFreeVariables
108
  | NoImplicitPrelude
109
110
111
  | UnknownExtension String
    deriving (Eq, Read, Show)

Björn Peemöller 's avatar
Björn Peemöller committed
112
113
114
115
-- |'Extension's available by @-e@ flag
pakcsExtensions :: [Extension]
pakcsExtensions = [Records, FunctionalPatterns]

116
-- |Classifies a 'String' as an 'Extension'
117
classifyExtension :: String -> Extension
118
classifyExtension str = case reads str of
119
120
121
122
123
124
125
126
  [(e, "")] -> e
  _         -> UnknownExtension str

-- | All available compiler options
options :: [OptDescr (Options -> Options)]
options =
  -- general
  [ Option "h?" ["help"]
127
      (NoArg (\ opts -> opts { optHelp = True }))
128
129
      "display this help and exit"
  , Option "V"  ["version"]
130
      (NoArg (\ opts -> opts { optVersion = True }))
131
132
      "show the version number"
  , Option ""   ["html"]
133
      (NoArg (\ opts -> opts { optHtml = True }))
134
135
      "generate html code"
  , Option "v"  ["verbosity"]
136
137
      (ReqArg (\ arg opts -> opts { optVerbosity =
        classifyVerbosity arg }) "<n>")
138
      "set verbosity level to <n>"
139
140
141
  , Option "" ["no-verb"]
      (NoArg (\ opts -> opts { optVerbosity = Quiet } ))
      "set verbosity level to quiet"
142
143
  -- compilation
  , Option "f"  ["force"]
144
      (NoArg (\ opts -> opts { optForce = True }))
145
146
      "force compilation of dependent files"
  , Option "i"  ["import-dir"]
147
148
      (ReqArg (\ arg opts -> opts { optImportPaths =
        nub $ arg : optImportPaths opts }) "DIR")
149
150
      "search for imports in DIR"
  , Option "o"  ["output"]
151
      (ReqArg (\ arg opts -> opts { optOutput = Just arg }) "FILE")
152
153
      "write code to FILE"
  , Option ""   ["no-subdir"]
154
      (NoArg (\ opts -> opts { optUseSubdir = False }))
155
156
      ("disable writing to '" ++ currySubdir ++ "' subdirectory")
  , Option ""   ["no-intf"]
157
      (NoArg (\ opts -> opts { optInterface = False }))
158
159
      "do not create an interface file"
  , Option ""   ["no-warn"]
160
      (NoArg (\ opts -> opts { optWarn = False }))
161
162
      "do not print warnings"
  , Option ""   ["no-overlap-warn"]
163
      (NoArg (\ opts -> opts { optOverlapWarn = False }))
164
165
166
      "do not print warnings for overlapping rules"
  -- target types
  , Option ""   ["parse-only"]
167
168
      (NoArg (\ opts -> opts { optTargetTypes =
        nub $ Parsed : optTargetTypes opts }))
169
170
      "generate source representation"
  , Option ""   ["flat"]
171
172
      (NoArg (\ opts -> opts { optTargetTypes =
        nub $ FlatCurry : optTargetTypes opts }))
173
174
      "generate FlatCurry code"
  , Option ""   ["extended-flat"]
175
176
      (NoArg (\ opts -> opts { optTargetTypes =
        nub $ ExtendedFlatCurry : optTargetTypes opts }))
177
178
      "generate FlatCurry code with source references"
  , Option ""   ["xml"]
179
180
      (NoArg (\ opts -> opts { optTargetTypes =
        nub $ FlatXml : optTargetTypes opts }))
181
182
      "generate flat xml code"
  , Option ""   ["acy"]
183
184
      (NoArg (\ opts -> opts { optTargetTypes =
        nub $ AbstractCurry : optTargetTypes opts }))
185
186
      "generate (type infered) AbstractCurry code"
  , Option ""   ["uacy"]
187
188
      (NoArg (\ opts -> opts { optTargetTypes =
        nub $ UntypedAbstractCurry : optTargetTypes opts }))
189
190
191
      "generate untyped AbstractCurry code"
  -- extensions
  , Option "e"  ["extended"]
192
      (NoArg (\ opts -> opts { optExtensions =
Björn Peemöller 's avatar
Björn Peemöller committed
193
        nub $ pakcsExtensions ++ optExtensions opts }))
194
195
      "enable extended Curry functionalities"
  , Option "X"   []
196
197
198
      (ReqArg (\ arg opts -> opts { optExtensions =
        nub $ classifyExtension arg : optExtensions opts }) "EXT")
      "enable language extension EXT"
199
200
  -- dump
  , Option ""   ["dump-all"]
201
      (NoArg (\ opts -> opts { optDumps = dumpAll }))
202
203
      "dump everything"
  , Option ""   ["dump-renamed"]
204
205
      (NoArg (\ opts -> opts { optDumps =
        nub $ DumpRenamed : optDumps opts }))
206
207
      "dump source code after renaming"
  , Option ""   ["dump-types"]
208
      (NoArg (\ opts -> opts { optDumps = nub $ DumpTypes : optDumps opts }))
209
210
      "dump types after type-checking"
  , Option ""   ["dump-desugared"]
211
212
      (NoArg (\ opts -> opts { optDumps =
        nub $ DumpDesugared : optDumps opts }))
213
214
      "dump source code after desugaring"
  , Option ""   ["dump-simplified"]
215
216
      (NoArg (\ opts -> opts { optDumps = nub $
        DumpSimplified : optDumps opts }))
217
218
      "dump source code after simplification"
  , Option ""   ["dump-lifted"]
219
      (NoArg (\ opts -> opts { optDumps = nub $ DumpLifted : optDumps opts }))
220
221
      "dump source code after lambda-lifting"
  , Option ""   ["dump-il"]
222
      (NoArg (\ opts -> opts { optDumps = nub $ DumpIL : optDumps opts }))
223
224
      "dump intermediate language before lifting"
  , Option ""   ["dump-case"]
225
      (NoArg (\ opts -> opts { optDumps = nub $ DumpCase : optDumps opts }))
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
      "dump intermediate language after case simplification"
  ]

-- |Parse the command line arguments
parseOpts :: [String] -> (Options, [String], [String])
parseOpts args = (foldl (flip ($)) defaultOptions opts, files, errs) where
  (opts, files, errs) = getOpt Permute options args

-- |Check options and files and return a list of error messages
checkOpts :: Options -> [String] -> [String]
checkOpts opts files
  | isJust (optOutput opts) && length files > 1
    = ["cannot specify -o with multiple targets"]
  | otherwise
    = []

-- |Print the usage information of the command line tool.
usage :: String -> String
usage prog = usageInfo header options
  where header = "usage: " ++ prog ++ " [OPTION] ... MODULE ..."

-- |Retrieve the compiler 'Options'
compilerOpts :: IO (String, Options, [String], [String])
compilerOpts = do
  args <- getArgs
  prog <- getProgName
  let (opts, files, errs) = parseOpts args
  return (prog, opts, files, errs ++ checkOpts opts files)