{- Configuration.Types -- describing the overall behavior of the compiler
Copyright (C) 2013  Benjamin Barenblat <bbaren@mit.edu>

This file is a part of decafc.

decafc is free software: you can redistribute it and/or modify it under the
terms of the MIT (X11) License as described in the LICENSE file.

decafc is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
PARTICULAR PURPOSE.  See the X11 license for more details. -}
module Configuration.Types where

--------------------------- The configuration type ----------------------------

data Configuration = Configuration { Configuration -> FilePath
input :: FilePath
                                   , Configuration -> Maybe CompilerStage
explicitTarget :: Maybe CompilerStage
                                   , Configuration -> Bool
debug :: Bool
                                   , Configuration -> OptimizationSpecification
opt :: OptimizationSpecification
                                   , Configuration -> Maybe FilePath
outputFileName :: Maybe FilePath
                                   } deriving (Configuration -> Configuration -> Bool
(Configuration -> Configuration -> Bool)
-> (Configuration -> Configuration -> Bool) -> Eq Configuration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Configuration -> Configuration -> Bool
== :: Configuration -> Configuration -> Bool
$c/= :: Configuration -> Configuration -> Bool
/= :: Configuration -> Configuration -> Bool
Eq)

defaultConfiguration :: Configuration
defaultConfiguration :: Configuration
defaultConfiguration = Configuration { $sel:input:Configuration :: FilePath
input = FilePath
forall a. HasCallStack => a
undefined
                                     , $sel:explicitTarget:Configuration :: Maybe CompilerStage
explicitTarget = Maybe CompilerStage
forall a. Maybe a
Nothing
                                     , $sel:debug:Configuration :: Bool
debug = Bool
False
                                     , $sel:opt:Configuration :: OptimizationSpecification
opt = [OptimizationName] -> OptimizationSpecification
Some [] -- no optimizations
                                     , $sel:outputFileName:Configuration :: Maybe FilePath
outputFileName = Maybe FilePath
forall a. Maybe a
Nothing
                                     }


------------------------------- Compiler stages -------------------------------

data CompilerStage = Scan
                   | Parse
                   | Cfg
                   | Inter
                   | Assembly
                   | LLVM
                   deriving (CompilerStage -> CompilerStage -> Bool
(CompilerStage -> CompilerStage -> Bool)
-> (CompilerStage -> CompilerStage -> Bool) -> Eq CompilerStage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompilerStage -> CompilerStage -> Bool
== :: CompilerStage -> CompilerStage -> Bool
$c/= :: CompilerStage -> CompilerStage -> Bool
/= :: CompilerStage -> CompilerStage -> Bool
Eq, Eq CompilerStage
Eq CompilerStage
-> (CompilerStage -> CompilerStage -> Ordering)
-> (CompilerStage -> CompilerStage -> Bool)
-> (CompilerStage -> CompilerStage -> Bool)
-> (CompilerStage -> CompilerStage -> Bool)
-> (CompilerStage -> CompilerStage -> Bool)
-> (CompilerStage -> CompilerStage -> CompilerStage)
-> (CompilerStage -> CompilerStage -> CompilerStage)
-> Ord CompilerStage
CompilerStage -> CompilerStage -> Bool
CompilerStage -> CompilerStage -> Ordering
CompilerStage -> CompilerStage -> CompilerStage
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CompilerStage -> CompilerStage -> Ordering
compare :: CompilerStage -> CompilerStage -> Ordering
$c< :: CompilerStage -> CompilerStage -> Bool
< :: CompilerStage -> CompilerStage -> Bool
$c<= :: CompilerStage -> CompilerStage -> Bool
<= :: CompilerStage -> CompilerStage -> Bool
$c> :: CompilerStage -> CompilerStage -> Bool
> :: CompilerStage -> CompilerStage -> Bool
$c>= :: CompilerStage -> CompilerStage -> Bool
>= :: CompilerStage -> CompilerStage -> Bool
$cmax :: CompilerStage -> CompilerStage -> CompilerStage
max :: CompilerStage -> CompilerStage -> CompilerStage
$cmin :: CompilerStage -> CompilerStage -> CompilerStage
min :: CompilerStage -> CompilerStage -> CompilerStage
Ord)
instance Show CompilerStage where
  show :: CompilerStage -> FilePath
show CompilerStage
Scan = FilePath
"scan"
  show CompilerStage
Parse = FilePath
"parse"
  show CompilerStage
Cfg = FilePath
"cfg"
  show CompilerStage
Inter = FilePath
"inter"
  show CompilerStage
Assembly = FilePath
"assembly"
  show CompilerStage
LLVM = FilePath
"llvm"
instance Read CompilerStage where
  readsPrec :: Int -> ReadS CompilerStage
readsPrec Int
_ FilePath
"scan" = [(CompilerStage
Scan, FilePath
"")]
  readsPrec Int
_ FilePath
"parse" = [(CompilerStage
Parse, FilePath
"")]
  readsPrec Int
_ FilePath
"cfg" = [(CompilerStage
Cfg, FilePath
"")]
  readsPrec Int
_ FilePath
"inter" = [(CompilerStage
Inter, FilePath
"")]
  readsPrec Int
_ FilePath
"assembly" = [(CompilerStage
Assembly, FilePath
"")]
  readsPrec Int
_ FilePath
"llvm" = [(CompilerStage
LLVM, FilePath
"")]
  readsPrec Int
_ FilePath
_ = []


-------------------------- Describing optimizations ---------------------------

data OptimizationSpecification = All
                               | Some ![OptimizationName]
                               deriving (OptimizationSpecification -> OptimizationSpecification -> Bool
(OptimizationSpecification -> OptimizationSpecification -> Bool)
-> (OptimizationSpecification -> OptimizationSpecification -> Bool)
-> Eq OptimizationSpecification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OptimizationSpecification -> OptimizationSpecification -> Bool
== :: OptimizationSpecification -> OptimizationSpecification -> Bool
$c/= :: OptimizationSpecification -> OptimizationSpecification -> Bool
/= :: OptimizationSpecification -> OptimizationSpecification -> Bool
Eq)

-- String might be the wrong type to use here, but whatever.
data OptimizationName = Enable !String
                      | Disable !String
                      deriving (OptimizationName -> OptimizationName -> Bool
(OptimizationName -> OptimizationName -> Bool)
-> (OptimizationName -> OptimizationName -> Bool)
-> Eq OptimizationName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OptimizationName -> OptimizationName -> Bool
== :: OptimizationName -> OptimizationName -> Bool
$c/= :: OptimizationName -> OptimizationName -> Bool
/= :: OptimizationName -> OptimizationName -> Bool
Eq)