git.iko.soy/rowtype-yoga/purescript-native
on 77a6451 help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/Environment.hs
268 lines 6.9 kB history raw
1-----------------------------------------------------------------------------
2--
3-- Module : Language.PureScript.Environment
4-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5-- License : MIT
6--
7-- Maintainer : Phil Freeman <paf31@cantab.net>
8-- Stability : experimental
9-- Portability :
10--
11-- |
12--
13-----------------------------------------------------------------------------
15{-# LANGUAGE DeriveDataTypeable #-}
16{-# LANGUAGE OverloadedStrings #-}
18module Language.PureScript.Environment where
20import Data.Data
21import Data.Maybe (fromMaybe)
22import qualified Data.Map as M
23import qualified Data.Text as T
24import qualified Data.Aeson as A
26import Language.PureScript.Kinds
27import Language.PureScript.Names
28import Language.PureScript.TypeClassDictionaries
29import Language.PureScript.Types
30import qualified Language.PureScript.Constants as C
32-- |
33-- The @Environment@ defines all values and types which are currently in scope:
34--
35data Environment = Environment {
36 -- |
37 -- Value names currently in scope
38 --
39 names :: M.Map (ModuleName, Ident) (Type, NameKind, NameVisibility)
40 -- |
41 -- Type names currently in scope
42 --
43 , types :: M.Map (Qualified ProperName) (Kind, TypeKind)
44 -- |
45 -- Data constructors currently in scope, along with their associated data type constructors
46 --
47 , dataConstructors :: M.Map (Qualified ProperName) (DataDeclType, ProperName, Type, [Ident])
48 -- |
49 -- Type synonyms currently in scope
50 --
51 , typeSynonyms :: M.Map (Qualified ProperName) ([(String, Maybe Kind)], Type)
52 -- |
53 -- Available type class dictionaries
54 --
55 , typeClassDictionaries :: M.Map (Maybe ModuleName) (M.Map (Qualified ProperName) (M.Map (Qualified Ident) TypeClassDictionaryInScope))
56 -- |
57 -- Type classes
58 --
59 , typeClasses :: M.Map (Qualified ProperName) ([(String, Maybe Kind)], [(Ident, Type)], [Constraint])
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 M.empty
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 deriving (Show, Eq, Data, Typeable)
100-- |
101-- The kinds of a type
102--
103data TypeKind
104 -- |
105 -- Data type
106 --
107 = DataType [(String, Maybe Kind)] [(ProperName, [Type])]
108 -- |
109 -- Type synonym
110 --
111 | TypeSynonym
112 -- |
113 -- Foreign data
114 --
115 | ExternData
116 -- |
117 -- A local type variable
118 --
119 | LocalTypeVariable
120 -- |
121 -- A scoped type variable
122 --
123 | ScopedTypeVar
124 deriving (Show, Eq, Data, Typeable)
126-- |
127-- The type ('data' or 'newtype') of a data type declaration
128--
129data DataDeclType
130 -- |
131 -- A standard data constructor
132 --
133 = Data
134 -- |
135 -- A newtype constructor
136 --
137 | Newtype deriving (Eq, Ord, Data, Typeable)
139instance Show DataDeclType where
140 show Data = "data"
141 show Newtype = "newtype"
143instance A.ToJSON DataDeclType where
144 toJSON = A.toJSON . show
146instance A.FromJSON DataDeclType where
147 parseJSON = A.withText "DataDeclType" $ \str ->
148 case str of
149 "data" -> return Data
150 "newtype" -> return Newtype
151 other -> fail $ "invalid type: '" ++ T.unpack other ++ "'"
153-- |
154-- Construct a ProperName in the Prim module
155--
156primName :: String -> Qualified ProperName
157primName = Qualified (Just $ ModuleName [ProperName C.prim]) . ProperName
159-- |
160-- Construct a type in the Prim module
161--
162primTy :: String -> Type
163primTy = TypeConstructor . primName
165-- |
166-- Type constructor for functions
167--
168tyFunction :: Type
169tyFunction = primTy "Function"
171-- |
172-- Type constructor for strings
173--
174tyString :: Type
175tyString = primTy "String"
177-- |
178-- Type constructor for strings
179--
180tyChar :: Type
181tyChar = primTy "Char"
183-- |
184-- Type constructor for numbers
185--
186tyNumber :: Type
187tyNumber = primTy "Number"
189-- |
190-- Type constructor for integers
191--
192tyInt :: Type
193tyInt = primTy "Int"
195-- |
196-- Type constructor for booleans
197--
198tyBoolean :: Type
199tyBoolean = primTy "Boolean"
201-- |
202-- Type constructor for arrays
203--
204tyArray :: Type
205tyArray = primTy "Array"
207-- |
208-- Type constructor for objects
209--
210tyObject :: Type
211tyObject = primTy "Object"
213-- |
214-- Check whether a type is an object
215--
216isObject :: Type -> Bool
217isObject = isTypeOrApplied tyObject
219-- |
220-- Check whether a type is a function
221--
222isFunction :: Type -> Bool
223isFunction = isTypeOrApplied tyFunction
225isTypeOrApplied :: Type -> Type -> Bool
226isTypeOrApplied t1 (TypeApp t2 _) = t1 == t2
227isTypeOrApplied t1 t2 = t1 == t2
229-- |
230-- Smart constructor for function types
231--
232function :: Type -> Type -> Type
233function t1 = TypeApp (TypeApp tyFunction t1)
235-- |
236-- The primitive types in the external javascript environment with their associated kinds.
237--
238primTypes :: M.Map (Qualified ProperName) (Kind, TypeKind)
239primTypes = M.fromList [ (primName "Function" , (FunKind Star (FunKind Star Star), ExternData))
240 , (primName "Array" , (FunKind Star Star, ExternData))
241 , (primName "Object" , (FunKind (Row Star) Star, ExternData))
242 , (primName "String" , (Star, ExternData))
243 , (primName "Char" , (Star, ExternData))
244 , (primName "Number" , (Star, ExternData))
245 , (primName "Int" , (Star, ExternData))
246 , (primName "Boolean" , (Star, ExternData)) ]
248-- |
249-- Finds information about data constructors from the current environment.
250--
251lookupConstructor :: Environment -> Qualified ProperName -> (DataDeclType, ProperName, Type, [Ident])
252lookupConstructor env ctor =
253 fromMaybe (error "Data constructor not found") $ ctor `M.lookup` dataConstructors env
255-- |
256-- Checks whether a data constructor is for a newtype.
257--
258isNewtypeConstructor :: Environment -> Qualified ProperName -> Bool
259isNewtypeConstructor e ctor = case lookupConstructor e ctor of
260 (Newtype, _, _, _) -> True
261 (Data, _, _, _) -> False
263-- |
264-- Finds information about values from the current environment.
265--
266lookupValue :: Environment -> Qualified Ident -> Maybe (Type, NameKind, NameVisibility)
267lookupValue env (Qualified (Just mn) ident) = (mn, ident) `M.lookup` names env
268lookupValue _ _ = Nothing