0 | ||| Utilities for dealing with %nomangle functions
 1 | module Compiler.NoMangle
 2 |
 3 | import Core.Context
 4 | import Libraries.Data.NameMap
 5 | import Libraries.Data.NameMap.Traversable
 6 |
 7 | export
 8 | record NoMangleMap where
 9 |     constructor MkNMMap
10 |     map : NameMap String
11 |
12 | ||| Get a map of all %export names
13 | ||| Errors for all invalid names, so the backend can skip checking
14 | ||| or adding escape characters.
15 | ||| @ backend what backend is this being used in?
16 | ||| @ valid a validator to check a name is valid
17 | |||         for the given backend
18 | export
19 | initNoMangle :
20 |     {auto d : Ref Ctxt Defs} ->
21 |     (backends : List String) ->
22 |     (valid : String -> Bool) ->
23 |     Core (Ref NoMangleMap NoMangleMap)
24 | initNoMangle backends valid = do
25 |     defs <- get Ctxt
26 |     map <- traverseNameMap
27 |         (\name, exps => do
28 |             let Just (backend, expName) = lookupBackend backends exps
29 |                 | Nothing => throw (GenericMsg EmptyFC """
30 |                     No valid %export specifier for \{show name}
31 |                       Supported backends: \{showSep ", " backends}
32 |                       Given backends: \{showSep ", " (fst <$> exps)}
33 |                     """)
34 |             let True = valid expName
35 |                 | False => throw (GenericMsg EmptyFC "\"\{expName}\" is not a valid name on \{backend} backend")
36 |             pure expName)
37 |         defs.foreignExports
38 |     newRef NoMangleMap $ MkNMMap map
39 |   where
40 |     lookupBackend : List String -> List (String, String) -> Maybe (String, String)
41 |     lookupBackend [] exps = Nothing
42 |     lookupBackend (b :: bs) exps =
43 |         case lookup b exps of
44 |             Just exp => Just (b, exp)
45 |             Nothing => lookupBackend bs exps
46 |
47 | export
48 | isNoMangle : NoMangleMap -> Name -> Maybe String
49 | isNoMangle nm n = lookup n nm.map
50 |
51 | export
52 | lookupNoMangle :
53 |     {auto nm : Ref NoMangleMap NoMangleMap} ->
54 |     Name ->
55 |     Core (Maybe String)
56 | lookupNoMangle n = pure $ isNoMangle !(get NoMangleMap) n
57 |