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