git.iko.soy/rowtype-yoga/purescript-native
on 8ca3d1e help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/Environment.hs
274 lines 7.3 kB history raw
1{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE TemplateHaskell #-}
5module Language.PureScript.Environment where
7import Data.Data
8import Data.Maybe (fromMaybe)
9import Data.Aeson.TH
10import qualified Data.Map as M
11import qualified Data.Text as T
12import qualified Data.Aeson as A
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-- |
22-- The @Environment@ defines all values and types which are currently in scope:
23--
24data Environment = Environment {
25 -- |
26 -- Value names currently in scope
27 --
28 names :: M.Map (ModuleName, Ident) (Type, NameKind, NameVisibility)
29 -- |
30 -- Type names currently in scope
31 --
32 , types :: M.Map (Qualified (ProperName 'TypeName)) (Kind, TypeKind)
33 -- |
34 -- Data constructors currently in scope, along with their associated type
35 -- constructor name, argument types and return type.
36 , dataConstructors :: M.Map (Qualified (ProperName 'ConstructorName)) (DataDeclType, ProperName 'TypeName, Type, [Ident])
37 -- |
38 -- Type synonyms currently in scope
39 --
40 , typeSynonyms :: M.Map (Qualified (ProperName 'TypeName)) ([(String, Maybe Kind)], Type)
41 -- |
42 -- Available type class dictionaries
43 --
44 , typeClassDictionaries :: M.Map (Maybe ModuleName) (M.Map (Qualified (ProperName 'ClassName)) (M.Map (Qualified Ident) TypeClassDictionaryInScope))
45 -- |
46 -- Type classes
47 --
48 , typeClasses :: M.Map (Qualified (ProperName 'ClassName)) ([(String, Maybe Kind)], [(Ident, Type)], [Constraint])
49 } deriving (Show, Read)
51-- |
52-- The initial environment with no values and only the default javascript types defined
53--
54initEnvironment :: Environment
55initEnvironment = Environment M.empty primTypes M.empty M.empty M.empty primClasses
57-- |
58-- The visibility of a name in scope
59--
60data NameVisibility
61 -- |
62 -- The name is defined in the current binding group, but is not visible
63 --
64 = Undefined
65 -- |
66 -- The name is defined in the another binding group, or has been made visible by a function binder
67 --
68 | Defined deriving (Show, Read, Eq)
70-- |
71-- A flag for whether a name is for an private or public value - only public values will be
72-- included in a generated externs file.
73--
74data NameKind
75 -- |
76 -- A private value introduced as an artifact of code generation (class instances, class member
77 -- accessors, etc.)
78 --
79 = Private
80 -- |
81 -- A public value for a module member or foreing import declaration
82 --
83 | Public
84 -- |
85 -- A name for member introduced by foreign import
86 --
87 | External deriving (Show, Read, Eq, Data, Typeable)
89-- |
90-- The kinds of a type
91--
92data TypeKind
93 -- |
94 -- Data type
95 --
96 = DataType [(String, Maybe Kind)] [(ProperName 'ConstructorName, [Type])]
97 -- |
98 -- Type synonym
99 --
100 | TypeSynonym
101 -- |
102 -- Foreign data
103 --
104 | ExternData
105 -- |
106 -- A local type variable
107 --
108 | LocalTypeVariable
109 -- |
110 -- A scoped type variable
111 --
112 | ScopedTypeVar
113 deriving (Show, Read, Eq, Data, Typeable)
115-- |
116-- The type ('data' or 'newtype') of a data type declaration
117--
118data DataDeclType
119 -- |
120 -- A standard data constructor
121 --
122 = Data
123 -- |
124 -- A newtype constructor
125 --
126 | Newtype deriving (Show, Read, Eq, Ord, Data, Typeable)
128showDataDeclType :: DataDeclType -> String
129showDataDeclType Data = "data"
130showDataDeclType Newtype = "newtype"
132instance A.ToJSON DataDeclType where
133 toJSON = A.toJSON . showDataDeclType
135instance A.FromJSON DataDeclType where
136 parseJSON = A.withText "DataDeclType" $ \str ->
137 case str of
138 "data" -> return Data
139 "newtype" -> return Newtype
140 other -> fail $ "invalid type: '" ++ T.unpack other ++ "'"
142-- |
143-- Construct a ProperName in the Prim module
144--
145primName :: String -> Qualified (ProperName a)
146primName = Qualified (Just $ ModuleName [ProperName C.prim]) . ProperName
148-- |
149-- Construct a type in the Prim module
150--
151primTy :: String -> Type
152primTy = TypeConstructor . primName
154-- |
155-- Type constructor for functions
156--
157tyFunction :: Type
158tyFunction = primTy "Function"
160-- |
161-- Type constructor for strings
162--
163tyString :: Type
164tyString = primTy "String"
166-- |
167-- Type constructor for strings
168--
169tyChar :: Type
170tyChar = primTy "Char"
172-- |
173-- Type constructor for numbers
174--
175tyNumber :: Type
176tyNumber = primTy "Number"
178-- |
179-- Type constructor for integers
180--
181tyInt :: Type
182tyInt = primTy "Int"
184-- |
185-- Type constructor for booleans
186--
187tyBoolean :: Type
188tyBoolean = primTy "Boolean"
190-- |
191-- Type constructor for arrays
192--
193tyArray :: Type
194tyArray = primTy "Array"
196-- |
197-- Type constructor for objects
198--
199tyObject :: Type
200tyObject = primTy "Object"
202-- |
203-- Check whether a type is an object
204--
205isObject :: Type -> Bool
206isObject = isTypeOrApplied tyObject
208-- |
209-- Check whether a type is a function
210--
211isFunction :: Type -> Bool
212isFunction = isTypeOrApplied tyFunction
214isTypeOrApplied :: Type -> Type -> Bool
215isTypeOrApplied t1 (TypeApp t2 _) = t1 == t2
216isTypeOrApplied t1 t2 = t1 == t2
218-- |
219-- Smart constructor for function types
220--
221function :: Type -> Type -> Type
222function t1 = TypeApp (TypeApp tyFunction t1)
224-- |
225-- The primitive types in the external javascript environment with their
226-- associated kinds. There is also a pseudo `Partial` type that corresponds to
227-- the class with the same name.
228--
229primTypes :: M.Map (Qualified (ProperName 'TypeName)) (Kind, TypeKind)
230primTypes =
231 M.fromList
232 [ (primName "Function", (FunKind Star (FunKind Star Star), ExternData))
233 , (primName "Array", (FunKind Star Star, ExternData))
234 , (primName "Object", (FunKind (Row Star) Star, ExternData))
235 , (primName "String", (Star, ExternData))
236 , (primName "Char", (Star, ExternData))
237 , (primName "Number", (Star, ExternData))
238 , (primName "Int", (Star, ExternData))
239 , (primName "Boolean", (Star, ExternData))
240 , (primName "Partial", (Star, ExternData))
241 ]
243-- |
244-- The primitive class map. This just contains to `Partial` class, used as a
245-- kind of magic constraint for partial functions.
246--
247primClasses :: M.Map (Qualified (ProperName 'ClassName)) ([(String, Maybe Kind)], [(Ident, Type)], [Constraint])
248primClasses =
249 M.fromList
250 [ (primName "Partial", ([], [], [])) ]
252-- |
253-- Finds information about data constructors from the current environment.
254--
255lookupConstructor :: Environment -> Qualified (ProperName 'ConstructorName) -> (DataDeclType, ProperName 'TypeName, Type, [Ident])
256lookupConstructor env ctor =
257 fromMaybe (internalError "Data constructor not found") $ ctor `M.lookup` dataConstructors env
259-- |
260-- Checks whether a data constructor is for a newtype.
261--
262isNewtypeConstructor :: Environment -> Qualified (ProperName 'ConstructorName) -> Bool
263isNewtypeConstructor e ctor = case lookupConstructor e ctor of
264 (Newtype, _, _, _) -> True
265 (Data, _, _, _) -> False
267-- |
268-- Finds information about values from the current environment.
269--
270lookupValue :: Environment -> Qualified Ident -> Maybe (Type, NameKind, NameVisibility)
271lookupValue env (Qualified (Just mn) ident) = (mn, ident) `M.lookup` names env
272lookupValue _ _ = Nothing
274$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''TypeKind)