git.iko.soy/rowtype-yoga/purescript-native
on d2dfad0 help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/Environment.hs
276 lines 7.2 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-- |
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
88 deriving (Show, Read, Eq)
90-- |
91-- The kinds of a type
92--
93data TypeKind
94 -- |
95 -- Data type
96 --
97 = DataType [(String, Maybe Kind)] [(ProperName 'ConstructorName, [Type])]
98 -- |
99 -- Type synonym
100 --
101 | TypeSynonym
102 -- |
103 -- Foreign data
104 --
105 | ExternData
106 -- |
107 -- A local type variable
108 --
109 | LocalTypeVariable
110 -- |
111 -- A scoped type variable
112 --
113 | ScopedTypeVar
114 deriving (Show, Read, Eq)
116-- |
117-- The type ('data' or 'newtype') of a data type declaration
118--
119data DataDeclType
120 -- |
121 -- A standard data constructor
122 --
123 = Data
124 -- |
125 -- A newtype constructor
126 --
127 | Newtype
128 deriving (Show, Read, Eq, Ord)
130showDataDeclType :: DataDeclType -> String
131showDataDeclType Data = "data"
132showDataDeclType Newtype = "newtype"
134instance A.ToJSON DataDeclType where
135 toJSON = A.toJSON . showDataDeclType
137instance A.FromJSON DataDeclType where
138 parseJSON = A.withText "DataDeclType" $ \str ->
139 case str of
140 "data" -> return Data
141 "newtype" -> return Newtype
142 other -> fail $ "invalid type: '" ++ T.unpack other ++ "'"
144-- |
145-- Construct a ProperName in the Prim module
146--
147primName :: String -> Qualified (ProperName a)
148primName = Qualified (Just $ ModuleName [ProperName C.prim]) . ProperName
150-- |
151-- Construct a type in the Prim module
152--
153primTy :: String -> Type
154primTy = TypeConstructor . primName
156-- |
157-- Type constructor for functions
158--
159tyFunction :: Type
160tyFunction = primTy "Function"
162-- |
163-- Type constructor for strings
164--
165tyString :: Type
166tyString = primTy "String"
168-- |
169-- Type constructor for strings
170--
171tyChar :: Type
172tyChar = primTy "Char"
174-- |
175-- Type constructor for numbers
176--
177tyNumber :: Type
178tyNumber = primTy "Number"
180-- |
181-- Type constructor for integers
182--
183tyInt :: Type
184tyInt = primTy "Int"
186-- |
187-- Type constructor for booleans
188--
189tyBoolean :: Type
190tyBoolean = primTy "Boolean"
192-- |
193-- Type constructor for arrays
194--
195tyArray :: Type
196tyArray = primTy "Array"
198-- |
199-- Type constructor for records
200--
201tyRecord :: Type
202tyRecord = primTy "Record"
204-- |
205-- Check whether a type is a record
206--
207isObject :: Type -> Bool
208isObject = isTypeOrApplied tyRecord
210-- |
211-- Check whether a type is a function
212--
213isFunction :: Type -> Bool
214isFunction = isTypeOrApplied tyFunction
216isTypeOrApplied :: Type -> Type -> Bool
217isTypeOrApplied t1 (TypeApp t2 _) = t1 == t2
218isTypeOrApplied t1 t2 = t1 == t2
220-- |
221-- Smart constructor for function types
222--
223function :: Type -> Type -> Type
224function t1 = TypeApp (TypeApp tyFunction t1)
226-- |
227-- The primitive types in the external javascript environment with their
228-- associated kinds. There is also a pseudo `Partial` type that corresponds to
229-- the class with the same name.
230--
231primTypes :: M.Map (Qualified (ProperName 'TypeName)) (Kind, TypeKind)
232primTypes =
233 M.fromList
234 [ (primName "Function", (FunKind Star (FunKind Star Star), ExternData))
235 , (primName "Array", (FunKind Star Star, ExternData))
236 , (primName "Record", (FunKind (Row Star) Star, ExternData))
237 , (primName "String", (Star, ExternData))
238 , (primName "Char", (Star, ExternData))
239 , (primName "Number", (Star, ExternData))
240 , (primName "Int", (Star, ExternData))
241 , (primName "Boolean", (Star, ExternData))
242 , (primName "Partial", (Star, ExternData))
243 ]
245-- |
246-- The primitive class map. This just contains to `Partial` class, used as a
247-- kind of magic constraint for partial functions.
248--
249primClasses :: M.Map (Qualified (ProperName 'ClassName)) ([(String, Maybe Kind)], [(Ident, Type)], [Constraint])
250primClasses =
251 M.fromList
252 [ (primName "Partial", ([], [], [])) ]
254-- |
255-- Finds information about data constructors from the current environment.
256--
257lookupConstructor :: Environment -> Qualified (ProperName 'ConstructorName) -> (DataDeclType, ProperName 'TypeName, Type, [Ident])
258lookupConstructor env ctor =
259 fromMaybe (internalError "Data constructor not found") $ ctor `M.lookup` dataConstructors env
261-- |
262-- Checks whether a data constructor is for a newtype.
263--
264isNewtypeConstructor :: Environment -> Qualified (ProperName 'ConstructorName) -> Bool
265isNewtypeConstructor e ctor = case lookupConstructor e ctor of
266 (Newtype, _, _, _) -> True
267 (Data, _, _, _) -> False
269-- |
270-- Finds information about values from the current environment.
271--
272lookupValue :: Environment -> Qualified Ident -> Maybe (Type, NameKind, NameVisibility)
273lookupValue env (Qualified (Just mn) ident) = (mn, ident) `M.lookup` names env
274lookupValue _ _ = Nothing
276$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''TypeKind)