forked from carp-lang/Carp
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Meta.hs
106 lines (88 loc) · 3.1 KB
/
Meta.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
module Meta
( stub,
get,
set,
fromBinder,
getBinderMetaValue,
updateBinderMeta,
Meta.member,
binderMember,
hide,
getString,
getCompilerKey,
validateAndSet,
CompilerKey (..),
)
where
import Data.Either (fromRight)
import Data.Maybe (fromMaybe)
import Info
import qualified Map
import Obj
import SymPath
import Types
--------------------------------------------------------------------------------
-- builtin special meta key values
-- These keys, when set, alter the compiler's behavior.
data CompilerKey = CNAME
-- Given a compiler key, returns the key name as a string along with a default value.
toKeyValue :: CompilerKey -> (String, XObj)
toKeyValue CNAME = ("c-name", (XObj (Str "") Nothing Nothing))
-- | Get the key associated with a compiler Meta key as a string.
getCompilerKey :: CompilerKey -> String
getCompilerKey = fst . toKeyValue
-- | Special meta KV pairs expect values of a certain XObj form.
--
-- Returns True for valid values for the given compiler key, False otherwise.
validateCompilerKeyValue :: CompilerKey -> Obj -> Bool
validateCompilerKeyValue CNAME (Str _) = True
validateCompilerKeyValue CNAME _ = False
-- | Validate and set a compiler key for a given MetaData object.
--
-- If the key or value is invalid, returns Left containing the original metadata.
-- If the key and value is valid, return Right containing the updated metadata.
validateAndSet :: MetaData -> CompilerKey -> XObj -> Either MetaData MetaData
validateAndSet meta key val
| validateCompilerKeyValue key (xobjObj val) =
Right (set (getCompilerKey key) val meta)
| otherwise = Left meta
--------------------------------------------------------------------------------
-- | A temporary binder for meta calls on symbols that haven't been declared yet.
-- Used in situations such as:
-- (doc foo "A foo.") <- foo hasn't been declared yet.
-- (def foo 0)
stub :: SymPath -> Binder
stub path =
Binder
emptyMeta
( XObj
( Lst
[ XObj MetaStub Nothing Nothing,
XObj (Sym path Symbol) Nothing Nothing
]
)
(Just dummyInfo)
(Just (VarTy "a"))
)
get :: String -> MetaData -> Maybe XObj
get key meta = Map.lookup key $ getMeta meta
set :: String -> XObj -> MetaData -> MetaData
set key value meta = MetaData $ Map.insert key value $ getMeta meta
fromBinder :: Binder -> MetaData
fromBinder = binderMeta
getBinderMetaValue :: String -> Binder -> Maybe XObj
getBinderMetaValue key binder =
get key $ fromBinder binder
updateBinderMeta :: Binder -> String -> XObj -> Binder