-- |
-- Module      :  Disco.Extensions
-- Copyright   :  disco team and contributors
-- Maintainer  :  byorgey@gmail.com
--
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Optional extensions to the disco language.
module Disco.Extensions (
  Ext (..),
  ExtSet,
  defaultExts,
  allExts,
  allExtsList,
  addExtension,
)
where

import Data.Set (Set)
import qualified Data.Set as S

type ExtSet = Set Ext

-- | Enumeration of optional language extensions.
data Ext
  = -- | Allow primitives, i.e. @$prim@
    Primitives
  | -- | Don't automatically import standard library modules
    NoStdLib
  | -- | Allow randomness.  This is not implemented yet.
    Randomness
  deriving (Ext -> Ext -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ext -> Ext -> Bool
$c/= :: Ext -> Ext -> Bool
== :: Ext -> Ext -> Bool
$c== :: Ext -> Ext -> Bool
Eq, Eq Ext
Ext -> Ext -> Bool
Ext -> Ext -> Ordering
Ext -> Ext -> Ext
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
min :: Ext -> Ext -> Ext
$cmin :: Ext -> Ext -> Ext
max :: Ext -> Ext -> Ext
$cmax :: Ext -> Ext -> Ext
>= :: Ext -> Ext -> Bool
$c>= :: Ext -> Ext -> Bool
> :: Ext -> Ext -> Bool
$c> :: Ext -> Ext -> Bool
<= :: Ext -> Ext -> Bool
$c<= :: Ext -> Ext -> Bool
< :: Ext -> Ext -> Bool
$c< :: Ext -> Ext -> Bool
compare :: Ext -> Ext -> Ordering
$ccompare :: Ext -> Ext -> Ordering
Ord, Int -> Ext -> ShowS
[Ext] -> ShowS
Ext -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ext] -> ShowS
$cshowList :: [Ext] -> ShowS
show :: Ext -> String
$cshow :: Ext -> String
showsPrec :: Int -> Ext -> ShowS
$cshowsPrec :: Int -> Ext -> ShowS
Show, ReadPrec [Ext]
ReadPrec Ext
Int -> ReadS Ext
ReadS [Ext]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Ext]
$creadListPrec :: ReadPrec [Ext]
readPrec :: ReadPrec Ext
$creadPrec :: ReadPrec Ext
readList :: ReadS [Ext]
$creadList :: ReadS [Ext]
readsPrec :: Int -> ReadS Ext
$creadsPrec :: Int -> ReadS Ext
Read, Int -> Ext
Ext -> Int
Ext -> [Ext]
Ext -> Ext
Ext -> Ext -> [Ext]
Ext -> Ext -> Ext -> [Ext]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Ext -> Ext -> Ext -> [Ext]
$cenumFromThenTo :: Ext -> Ext -> Ext -> [Ext]
enumFromTo :: Ext -> Ext -> [Ext]
$cenumFromTo :: Ext -> Ext -> [Ext]
enumFromThen :: Ext -> Ext -> [Ext]
$cenumFromThen :: Ext -> Ext -> [Ext]
enumFrom :: Ext -> [Ext]
$cenumFrom :: Ext -> [Ext]
fromEnum :: Ext -> Int
$cfromEnum :: Ext -> Int
toEnum :: Int -> Ext
$ctoEnum :: Int -> Ext
pred :: Ext -> Ext
$cpred :: Ext -> Ext
succ :: Ext -> Ext
$csucc :: Ext -> Ext
Enum, Ext
forall a. a -> a -> Bounded a
maxBound :: Ext
$cmaxBound :: Ext
minBound :: Ext
$cminBound :: Ext
Bounded)

-- | The default set of language extensions (currently, the empty set).
defaultExts :: ExtSet
defaultExts :: ExtSet
defaultExts = forall a. Set a
S.empty

-- | A set of all possible language extensions, provided for convenience.
allExts :: ExtSet
allExts :: ExtSet
allExts = forall a. Ord a => [a] -> Set a
S.fromList [Ext]
allExtsList

-- | All possible language extensions in the form of a list.
allExtsList :: [Ext]
allExtsList :: [Ext]
allExtsList = [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound]

-- | Add an extension to an extension set.
addExtension :: Ext -> ExtSet -> ExtSet
addExtension :: Ext -> ExtSet -> ExtSet
addExtension = forall a. Ord a => a -> Set a -> Set a
S.insert