Make sure that all names in a program are safe for use in JS code
This commit is contained in:
parent
e690c427b7
commit
f8bf89b48d
4 changed files with 90 additions and 13 deletions
|
@ -54,6 +54,7 @@ Library
|
||||||
Generate.Cases,
|
Generate.Cases,
|
||||||
Transform.Canonicalize,
|
Transform.Canonicalize,
|
||||||
Transform.Check,
|
Transform.Check,
|
||||||
|
Transform.SafeNames,
|
||||||
Transform.SortDefinitions,
|
Transform.SortDefinitions,
|
||||||
Transform.Substitute,
|
Transform.Substitute,
|
||||||
Transform.Optimize,
|
Transform.Optimize,
|
||||||
|
@ -132,6 +133,7 @@ Executable elm
|
||||||
Generate.Cases,
|
Generate.Cases,
|
||||||
Transform.Canonicalize,
|
Transform.Canonicalize,
|
||||||
Transform.Check,
|
Transform.Check,
|
||||||
|
Transform.SafeNames,
|
||||||
Transform.SortDefinitions,
|
Transform.SortDefinitions,
|
||||||
Transform.Substitute,
|
Transform.Substitute,
|
||||||
Transform.Optimize,
|
Transform.Optimize,
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
module Generate.JavaScript where
|
module Generate.JavaScript (generate) where
|
||||||
|
|
||||||
import Control.Arrow (first,(***))
|
import Control.Arrow (first,(***))
|
||||||
import Control.Applicative ((<$>),(<*>))
|
import Control.Applicative ((<$>),(<*>))
|
||||||
|
@ -14,15 +14,7 @@ import SourceSyntax.Location
|
||||||
import qualified Transform.SortDefinitions as SD
|
import qualified Transform.SortDefinitions as SD
|
||||||
import Language.ECMAScript3.Syntax
|
import Language.ECMAScript3.Syntax
|
||||||
import Language.ECMAScript3.PrettyPrint
|
import Language.ECMAScript3.PrettyPrint
|
||||||
import Parse.Helpers (jsReserveds)
|
import qualified Transform.SafeNames as MakeSafe
|
||||||
|
|
||||||
makeSafe :: String -> String
|
|
||||||
makeSafe = List.intercalate "." . map dereserve . split . deprime
|
|
||||||
where
|
|
||||||
deprime = map (\c -> if c == '\'' then '$' else c)
|
|
||||||
dereserve x = case Set.member x jsReserveds of
|
|
||||||
False -> x
|
|
||||||
True -> "$" ++ x
|
|
||||||
|
|
||||||
split :: String -> [String]
|
split :: String -> [String]
|
||||||
split = go []
|
split = go []
|
||||||
|
@ -33,7 +25,7 @@ split = go []
|
||||||
| otherwise -> go (vars ++ [x]) rest
|
| otherwise -> go (vars ++ [x]) rest
|
||||||
(x,[]) -> vars ++ [x]
|
(x,[]) -> vars ++ [x]
|
||||||
|
|
||||||
var name = Id () (makeSafe name)
|
var name = Id () name
|
||||||
ref name = VarRef () (var name)
|
ref name = VarRef () (var name)
|
||||||
prop name = PropId () (var name)
|
prop name = PropId () (var name)
|
||||||
f <| x = CallExpr () f [x]
|
f <| x = CallExpr () f [x]
|
||||||
|
@ -185,7 +177,7 @@ expression (L span expr) =
|
||||||
do es' <- mapM expression es
|
do es' <- mapM expression es
|
||||||
return $ ObjectLit () (ctor : fields es')
|
return $ ObjectLit () (ctor : fields es')
|
||||||
where
|
where
|
||||||
ctor = (prop "ctor", string (makeSafe name))
|
ctor = (prop "ctor", string name)
|
||||||
fields = zipWith (\n e -> (prop ("_" ++ show n), e)) [0..]
|
fields = zipWith (\n e -> (prop ("_" ++ show n), e)) [0..]
|
||||||
|
|
||||||
Markdown uid doc es ->
|
Markdown uid doc es ->
|
||||||
|
@ -291,10 +283,11 @@ clause span variable (Case.Clause value vars mtch) =
|
||||||
|
|
||||||
|
|
||||||
generate :: MetadataModule () () -> String
|
generate :: MetadataModule () () -> String
|
||||||
generate modul =
|
generate unsafeModule =
|
||||||
show . prettyPrint $ setup (Just "Elm") (names modul ++ ["make"]) ++
|
show . prettyPrint $ setup (Just "Elm") (names modul ++ ["make"]) ++
|
||||||
[ assign ("Elm" : names modul ++ ["make"]) (function ["_elm"] programStmts) ]
|
[ assign ("Elm" : names modul ++ ["make"]) (function ["_elm"] programStmts) ]
|
||||||
where
|
where
|
||||||
|
modul = MakeSafe.metadataModule unsafeModule
|
||||||
thisModule = dotSep ("_elm" : names modul ++ ["values"])
|
thisModule = dotSep ("_elm" : names modul ++ ["values"])
|
||||||
programStmts =
|
programStmts =
|
||||||
concat [ setup (Just "_elm") (names modul ++ ["values"])
|
concat [ setup (Just "_elm") (names modul ++ ["values"])
|
||||||
|
|
|
@ -36,6 +36,10 @@ jsReserveds = Set.fromList
|
||||||
, "const", "enum", "export", "extends", "import", "super", "implements"
|
, "const", "enum", "export", "extends", "import", "super", "implements"
|
||||||
, "interface", "let", "package", "private", "protected", "public"
|
, "interface", "let", "package", "private", "protected", "public"
|
||||||
, "static", "yield"
|
, "static", "yield"
|
||||||
|
-- reserved by the Elm runtime system
|
||||||
|
, "Elm", "ElmRuntime"
|
||||||
|
, "F2", "F3", "F4", "F5", "F6", "F7", "F8", "F9"
|
||||||
|
, "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9"
|
||||||
]
|
]
|
||||||
|
|
||||||
expecting = flip (<?>)
|
expecting = flip (<?>)
|
||||||
|
|
78
compiler/Transform/SafeNames.hs
Normal file
78
compiler/Transform/SafeNames.hs
Normal file
|
@ -0,0 +1,78 @@
|
||||||
|
{-# OPTIONS_GHC -Wall #-}
|
||||||
|
module Transform.SafeNames (metadataModule) where
|
||||||
|
|
||||||
|
import Control.Arrow (first, (***))
|
||||||
|
import SourceSyntax.Expression
|
||||||
|
import SourceSyntax.Location
|
||||||
|
import SourceSyntax.Module
|
||||||
|
import SourceSyntax.Pattern
|
||||||
|
import qualified Data.Set as Set
|
||||||
|
import qualified Parse.Helpers as PHelp
|
||||||
|
|
||||||
|
var :: String -> String
|
||||||
|
var = dereserve . deprime
|
||||||
|
where
|
||||||
|
deprime = map (\c -> if c == '\'' then '$' else c)
|
||||||
|
dereserve x = case Set.member x PHelp.jsReserveds of
|
||||||
|
False -> x
|
||||||
|
True -> "$" ++ x
|
||||||
|
|
||||||
|
pattern :: Pattern -> Pattern
|
||||||
|
pattern pat =
|
||||||
|
case pat of
|
||||||
|
PVar x -> PVar (var x)
|
||||||
|
PLiteral _ -> pat
|
||||||
|
PRecord fs -> PRecord (map var fs)
|
||||||
|
PAnything -> pat
|
||||||
|
PAlias x p -> PAlias (var x) (pattern p)
|
||||||
|
PData name ps -> PData name (map pattern ps)
|
||||||
|
|
||||||
|
expression :: LExpr t v -> LExpr t v
|
||||||
|
expression (L loc expr) =
|
||||||
|
let f = expression in
|
||||||
|
L loc $
|
||||||
|
case expr of
|
||||||
|
Literal _ -> expr
|
||||||
|
Var x -> Var (var x)
|
||||||
|
Range e1 e2 -> Range (f e1) (f e2)
|
||||||
|
ExplicitList es -> ExplicitList (map f es)
|
||||||
|
Binop op e1 e2 -> Binop op (f e1) (f e2)
|
||||||
|
Lambda p e -> Lambda (pattern p) (f e)
|
||||||
|
App e1 e2 -> App (f e1) (f e2)
|
||||||
|
MultiIf ps -> MultiIf (map (f *** f) ps)
|
||||||
|
Let defs body -> Let (map definition defs) (f body)
|
||||||
|
Case e cases -> Case (f e) $ map (pattern *** f) cases
|
||||||
|
Data name es -> Data name (map f es)
|
||||||
|
Access e x -> Access (f e) (var x)
|
||||||
|
Remove e x -> Remove (f e) (var x)
|
||||||
|
Insert e x v -> Insert (f e) (var x) (f v)
|
||||||
|
Modify r fs -> Modify (f r) (map (var *** f) fs)
|
||||||
|
Record fs -> Record (map (var *** f) fs)
|
||||||
|
Markdown uid md es -> Markdown uid md (map f es)
|
||||||
|
|
||||||
|
definition :: Def t v -> Def t v
|
||||||
|
definition def =
|
||||||
|
case def of
|
||||||
|
Def p e -> Def (pattern p) (expression e)
|
||||||
|
TypeAnnotation name t -> TypeAnnotation (var name) t
|
||||||
|
|
||||||
|
metadataModule :: MetadataModule t v -> MetadataModule t v
|
||||||
|
metadataModule modul =
|
||||||
|
modul
|
||||||
|
{ names = map var (names modul)
|
||||||
|
, exports = map var (exports modul)
|
||||||
|
, imports = map (first var) (imports modul)
|
||||||
|
, program = expression (program modul)
|
||||||
|
, aliases =
|
||||||
|
let makeSafe (name, tvars, tipe) = (var name, tvars, tipe)
|
||||||
|
in map makeSafe (aliases modul)
|
||||||
|
, datatypes =
|
||||||
|
let makeSafe (name,tvars,ctors) = (var name, tvars, map (first var) ctors)
|
||||||
|
in map makeSafe (datatypes modul)
|
||||||
|
, foreignImports =
|
||||||
|
let makeSafe (js,expr,elm,tipe) = (js, expression expr, var elm, tipe)
|
||||||
|
in map makeSafe (foreignImports modul)
|
||||||
|
, foreignExports =
|
||||||
|
let makeSafe (js,elm,tipe) = (js, var elm, tipe)
|
||||||
|
in map makeSafe (foreignExports modul)
|
||||||
|
}
|
Loading…
Reference in a new issue