CompilerOpts.hs 8.67 KB
Newer Older
1
2
3
4
{- |CompilerOpts - Defines data structures containing options for
    compiling Curry programs (see module "CurryCompiler")

    September 2005, Martin Engelke (men@informatik.uni-kiel.de)
5
6
    March 2007, extensions by Sebastian Fischer (sebf@informatik.uni-kiel.de)
    May 2011, refinements by Bjoern Peemoeller (bjp@informatik.uni-kiel.de)
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
-}
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
31
  , optUseSubdir   :: Bool           -- ^ use subdir for output?
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
  , optInterface   :: Bool           -- ^ do not create an interface file
  , optWarn        :: Bool           -- ^ warnings on/off
  , optOverlapWarn :: Bool           -- ^ "overlap" warnings on/off
  , optTargetTypes :: [TargetType]   -- ^ what to generate
  , optExtensions  :: [Extension]    -- ^ language extensions
  , optDumps       :: [DumpLevel]    -- ^ dumps
  } -- deriving Show

-- | 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       = []
  }

59
-- |Data type representing the type of the target file
60
61
62
63
64
65
66
67
68
data TargetType
  = Parsed
  | FlatCurry
  | ExtendedFlatCurry
  | FlatXml
  | AbstractCurry
  | UntypedAbstractCurry
    deriving Eq

69
-- |Data type representing the verbosity level
70
71
72
73
74
data Verbosity
  = Quiet
  | Verbose
    deriving Eq

75
-- |Classifies a number as a 'Verbosity'
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
classifyVerbosity :: String -> Verbosity
classifyVerbosity "0" = Quiet
classifyVerbosity _   = Verbose

-- TODO: dump FlatCurry code, dump AbstractCurry code, dump after 'case'
-- expansion

-- |Data type for representing code dumps
data DumpLevel
  = 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
  | DumpIL           -- ^ dump IL code after translation
  | DumpCase         -- ^ dump IL code after case elimination
    deriving (Eq, Bounded, Enum, Show)

94
-- |All available 'DumpLevel's
95
96
97
98
99
100
dumpAll :: [DumpLevel]
dumpAll = [minBound .. maxBound]

-- |Data type representing language extensions
data Extension
  = BerndExtension -- TODO: Give it a more concise name
101
102
  | Records
  | FunctionPatterns
103
  | AnonymousFreeVariables
104
  | NoImplicitPrelude
105
106
107
  | UnknownExtension String
    deriving (Eq, Read, Show)

108
-- |Classifies a 'String' as an 'Extension'
109
classifyExtension :: String -> Extension
110
classifyExtension str = case reads str of
111
112
113
114
115
116
117
118
  [(e, "")] -> e
  _         -> UnknownExtension str

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