git.iko.soy/rowtype-yoga/purescript-native
on e0b2655 help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/Environment.hs
292 lines 8.4 kB history raw
1{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE TemplateHaskell #-}
4module Language.PureScript.Environment where
6import Prelude.Compat
8import Data.Aeson.TH
9import Data.Maybe (fromMaybe)
10import qualified Data.Aeson as A
11import qualified Data.Map as M
12import qualified Data.Text as T
14import Language.PureScript.Crash
15import Language.PureScript.Kinds
16import Language.PureScript.Names
17import Language.PureScript.TypeClassDictionaries
18import Language.PureScript.Types
19import qualified Language.PureScript.Constants as C
21-- | The @Environment@ defines all values and types which are currently in scope:
22data Environment = Environment
23 { names :: M.Map (Qualified Ident) (Type, NameKind, NameVisibility)
24 -- ^ Values currently in scope
25 , types :: M.Map (Qualified (ProperName 'TypeName)) (Kind, TypeKind)
26 -- ^ Type names currently in scope
27 , dataConstructors :: M.Map (Qualified (ProperName 'ConstructorName)) (DataDeclType, ProperName 'TypeName, Type, [Ident])
28 -- ^ Data constructors currently in scope, along with their associated type
29 -- constructor name, argument types and return type.
30 , typeSynonyms :: M.Map (Qualified (ProperName 'TypeName)) ([(String, Maybe Kind)], Type)
31 -- ^ Type synonyms currently in scope
32 , typeClassDictionaries :: M.Map (Maybe ModuleName) (M.Map (Qualified (ProperName 'ClassName)) (M.Map (Qualified Ident) TypeClassDictionaryInScope))
33 -- ^ Available type class dictionaries
34 , typeClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData
35 -- ^ Type classes
36 } deriving Show
38-- | Information about a type class
39data TypeClassData = TypeClassData
40 { typeClassArguments :: [(String, Maybe Kind)]
41 -- ^ A list of type argument names, and their kinds, where kind annotations
42 -- were provided.
43 , typeClassMembers :: [(Ident, Type)]
44 -- ^ A list of type class members and their types. Type arguments listed above
45 -- are considered bound in these types.
46 , typeClassSuperclasses :: [Constraint]
47 -- ^ A list of superclasses of this type class. Type arguments listed above
48 -- are considered bound in the types appearing in these constraints.
49 , typeClassDependencies :: [FunctionalDependency]
50 -- ^ A list of functional dependencies for the type arguments of this class.
51 } deriving Show
53-- | A functional dependency indicates a relationship between two sets of
54-- type arguments in a class declaration.
55data FunctionalDependency = FunctionalDependency
56 { fdDeterminers :: [Int]
57 -- ^ the type arguments which determine the determined type arguments
58 , fdDetermined :: [Int]
59 -- ^ the determined type arguments
60 } deriving Show
62-- |
63-- The initial environment with no values and only the default javascript types defined
64--
65initEnvironment :: Environment
66initEnvironment = Environment M.empty primTypes M.empty M.empty M.empty primClasses
68-- |
69-- The visibility of a name in scope
70--
71data NameVisibility
72 -- |
73 -- The name is defined in the current binding group, but is not visible
74 --
75 = Undefined
76 -- |
77 -- The name is defined in the another binding group, or has been made visible by a function binder
78 --
79 | Defined deriving (Show, Eq)
81-- |
82-- A flag for whether a name is for an private or public value - only public values will be
83-- included in a generated externs file.
84--
85data NameKind
86 -- |
87 -- A private value introduced as an artifact of code generation (class instances, class member
88 -- accessors, etc.)
89 --
90 = Private
91 -- |
92 -- A public value for a module member or foreing import declaration
93 --
94 | Public
95 -- |
96 -- A name for member introduced by foreign import
97 --
98 | External
99 deriving (Show, Eq)
101-- |
102-- The kinds of a type
103--
104data TypeKind
105 -- |
106 -- Data type
107 --
108 = DataType [(String, Maybe Kind)] [(ProperName 'ConstructorName, [Type])]
109 -- |
110 -- Type synonym
111 --
112 | TypeSynonym
113 -- |
114 -- Foreign data
115 --
116 | ExternData
117 -- |
118 -- A local type variable
119 --
120 | LocalTypeVariable
121 -- |
122 -- A scoped type variable
123 --
124 | ScopedTypeVar
125 deriving (Show, Eq)
127-- |
128-- The type ('data' or 'newtype') of a data type declaration
129--
130data DataDeclType
131 -- |
132 -- A standard data constructor
133 --
134 = Data
135 -- |
136 -- A newtype constructor
137 --
138 | Newtype
139 deriving (Show, Eq, Ord)
141showDataDeclType :: DataDeclType -> String
142showDataDeclType Data = "data"
143showDataDeclType Newtype = "newtype"
145instance A.ToJSON DataDeclType where
146 toJSON = A.toJSON . showDataDeclType
148instance A.FromJSON DataDeclType where
149 parseJSON = A.withText "DataDeclType" $ \str ->
150 case str of
151 "data" -> return Data
152 "newtype" -> return Newtype
153 other -> fail $ "invalid type: '" ++ T.unpack other ++ "'"
155-- |
156-- Construct a ProperName in the Prim module
157--
158primName :: String -> Qualified (ProperName a)
159primName = Qualified (Just $ ModuleName [ProperName C.prim]) . ProperName
161-- |
162-- Construct a type in the Prim module
163--
164primTy :: String -> Type
165primTy = TypeConstructor . primName
167-- |
168-- Type constructor for functions
169--
170tyFunction :: Type
171tyFunction = primTy "Function"
173-- |
174-- Type constructor for strings
175--
176tyString :: Type
177tyString = primTy "String"
179-- |
180-- Type constructor for strings
181--
182tyChar :: Type
183tyChar = primTy "Char"
185-- |
186-- Type constructor for numbers
187--
188tyNumber :: Type
189tyNumber = primTy "Number"
191-- |
192-- Type constructor for integers
193--
194tyInt :: Type
195tyInt = primTy "Int"
197-- |
198-- Type constructor for booleans
199--
200tyBoolean :: Type
201tyBoolean = primTy "Boolean"
203-- |
204-- Type constructor for arrays
205--
206tyArray :: Type
207tyArray = primTy "Array"
209-- |
210-- Type constructor for records
211--
212tyRecord :: Type
213tyRecord = primTy "Record"
215-- |
216-- Check whether a type is a record
217--
218isObject :: Type -> Bool
219isObject = isTypeOrApplied tyRecord
221-- |
222-- Check whether a type is a function
223--
224isFunction :: Type -> Bool
225isFunction = isTypeOrApplied tyFunction
227isTypeOrApplied :: Type -> Type -> Bool
228isTypeOrApplied t1 (TypeApp t2 _) = t1 == t2
229isTypeOrApplied t1 t2 = t1 == t2
231-- |
232-- Smart constructor for function types
233--
234function :: Type -> Type -> Type
235function t1 = TypeApp (TypeApp tyFunction t1)
237-- |
238-- The primitive types in the external javascript environment with their
239-- associated kinds. There is also a pseudo `Partial` type that corresponds to
240-- the class with the same name.
241--
242primTypes :: M.Map (Qualified (ProperName 'TypeName)) (Kind, TypeKind)
243primTypes =
244 M.fromList
245 [ (primName "Function", (FunKind Star (FunKind Star Star), ExternData))
246 , (primName "Array", (FunKind Star Star, ExternData))
247 , (primName "Record", (FunKind (Row Star) Star, ExternData))
248 , (primName "String", (Star, ExternData))
249 , (primName "Char", (Star, ExternData))
250 , (primName "Number", (Star, ExternData))
251 , (primName "Int", (Star, ExternData))
252 , (primName "Boolean", (Star, ExternData))
253 , (primName "Partial", (Star, ExternData))
254 , (primName "Fail", (FunKind Symbol Star, ExternData))
255 , (primName "TypeString", (FunKind Star Symbol, ExternData))
256 , (primName "TypeConcat", (FunKind Symbol (FunKind Symbol Symbol), ExternData))
257 ]
259-- |
260-- The primitive class map. This just contains to `Partial` class, used as a
261-- kind of magic constraint for partial functions.
262--
263primClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData
264primClasses =
265 M.fromList
266 [ (primName "Partial", (TypeClassData [] [] [] []))
267 , (primName "Fail", (TypeClassData [("message", Just Symbol)] [] [] []))
268 ]
270-- |
271-- Finds information about data constructors from the current environment.
272--
273lookupConstructor :: Environment -> Qualified (ProperName 'ConstructorName) -> (DataDeclType, ProperName 'TypeName, Type, [Ident])
274lookupConstructor env ctor =
275 fromMaybe (internalError "Data constructor not found") $ ctor `M.lookup` dataConstructors env
277-- |
278-- Checks whether a data constructor is for a newtype.
279--
280isNewtypeConstructor :: Environment -> Qualified (ProperName 'ConstructorName) -> Bool
281isNewtypeConstructor e ctor = case lookupConstructor e ctor of
282 (Newtype, _, _, _) -> True
283 (Data, _, _, _) -> False
285-- |
286-- Finds information about values from the current environment.
287--
288lookupValue :: Environment -> Qualified Ident -> Maybe (Type, NameKind, NameVisibility)
289lookupValue env ident = ident `M.lookup` names env
291$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''TypeKind)
292$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''FunctionalDependency)