on e2aa608 help sign in
elk/compiler/Transform/SafeNames.hs
77 lines 2.7 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Transform.SafeNames (metadataModule) where
4import Control.Arrow (first, (***))
5import qualified Data.List as List
6import qualified Data.Set as Set
8import qualified Parse.Helpers as PHelp
9import SourceSyntax.Annotation
10import SourceSyntax.Expression
11import qualified SourceSyntax.Helpers as SHelp
12import SourceSyntax.Module
13import qualified SourceSyntax.Pattern as P
14import qualified SourceSyntax.Variable as Variable
16var :: String -> String
17var = List.intercalate "." . map (dereserve . deprime) . SHelp.splitDots
18 where
19 deprime = map (\c -> if c == '\'' then '$' else c)
20 dereserve x = case Set.member x PHelp.jsReserveds of
21 False -> x
22 True -> "$" ++ x
24pattern :: P.Pattern -> P.Pattern
25pattern pat =
26 case pat of
27 P.Var x -> P.Var (var x)
28 P.Literal _ -> pat
29 P.Record fs -> P.Record (map var fs)
30 P.Anything -> pat
31 P.Alias x p -> P.Alias (var x) (pattern p)
32 P.Data name ps -> P.Data name (map pattern ps)
34-- TODO: should be "normal expression" -> "expression for JS generation"
35expression :: Expr -> Expr
36expression (A ann expr) =
37 let f = expression in
38 A ann $
39 case expr of
40 Literal _ -> expr
41 Var (Variable.Raw x) -> rawVar (var x)
42 Range e1 e2 -> Range (f e1) (f e2)
43 ExplicitList es -> ExplicitList (map f es)
44 Binop op e1 e2 -> Binop op (f e1) (f e2)
45 Lambda p e -> Lambda (pattern p) (f e)
46 App e1 e2 -> App (f e1) (f e2)
47 MultiIf ps -> MultiIf (map (f *** f) ps)
48 Let defs body -> Let (map definition defs) (f body)
49 Case e cases -> Case (f e) $ map (pattern *** f) cases
50 Data name es -> Data name (map f es)
51 Access e x -> Access (f e) (var x)
52 Remove e x -> Remove (f e) (var x)
53 Insert e x v -> Insert (f e) (var x) (f v)
54 Modify r fs -> Modify (f r) (map (var *** f) fs)
55 Record fs -> Record (map (var *** f) fs)
56 Markdown uid md es -> Markdown uid md (map f es)
57 PortIn name st -> PortIn name st
58 PortOut name st signal -> PortOut name st (f signal)
60definition :: Def -> Def
61definition (Definition p e t) =
62 Definition (pattern p) (expression e) t
64metadataModule :: MetadataModule -> MetadataModule
65metadataModule modul =
66 modul
67 { names = map var (names modul)
68 , exports = map var (exports modul)
69 , imports = map (first var) (imports modul)
70 , program = expression (program modul)
71 , aliases =
72 let makeSafe (name,tvars,tipe) = (var name, tvars, tipe)
73 in map makeSafe (aliases modul)
74 , datatypes =
75 let makeSafe (name,tvars,ctors) = (var name, tvars, map (first var) ctors)
76 in map makeSafe (datatypes modul)
77 }