git.iko.soy/elk
on master help sign in
Get generation working
3a07298Evan Czaplicki
compiler/Generate/JavaScript.hs+26−24
compare with master
unifiedsplit
@@ -1,6 +1,5 @@
1module Generate.JavaScript where
1module Generate.JavaScript where
2
2
3−import Control.Applicative ((<$>))
4import Control.Arrow ((***))
3import Control.Arrow ((***))
5import qualified Data.List as List
4import qualified Data.List as List
6import qualified Data.Map as Map
5import qualified Data.Map as Map
@@ -13,13 +12,15 @@ import SourceSyntax.Location
13import qualified Transform.SortDefinitions as SD
12import qualified Transform.SortDefinitions as SD
14import Language.ECMAScript3.Syntax
13import Language.ECMAScript3.Syntax
15import Language.ECMAScript3.PrettyPrint
14import Language.ECMAScript3.PrettyPrint
16−import Parse.Helpers (makeSafe, iParse)
15+import Parse.Helpers (jsReserveds)
17
16
18−import Parse.Expression
17+makeSafe :: String -> String
19−
18+makeSafe = dereserve . deprime
20−testExpr str = case iParse expr "" str of
19+ where
21− Right e -> prettyPrint (expression (e :: LExpr () ()))
20+ deprime = map (\c -> if c == '\'' then '$' else c)
22− Left err -> error (show err)
21+ dereserve x = case Set.member x jsReserveds of
22+ False -> x
23+ True -> "$" ++ x
23
24
24split = go []
25split = go []
25 where
26 where
@@ -62,7 +63,7 @@ literal lit =
62 Chr c -> string [c]
63 Chr c -> string [c]
63 Str s -> ref "_str" <| string s
64 Str s -> ref "_str" <| string s
64 IntNum n -> IntLit () n
65 IntNum n -> IntLit () n
65−-- FloatNum n -> NumLit () (float2Double n) -- wrong!!!
66+ FloatNum n -> NumLit () n
66 Boolean b -> BoolLit () b
67 Boolean b -> BoolLit () b
67
68
68expression :: LExpr () () -> Expression ()
69expression :: LExpr () () -> Expression ()
@@ -73,10 +74,10 @@ expression (L span expr) =
73 Range lo hi -> get "_L.range" `call` [expression lo, expression hi]
74 Range lo hi -> get "_L.range" `call` [expression lo, expression hi]
74
75
75 Access e x -> DotRef () (expression e) (var x)
76 Access e x -> DotRef () (expression e) (var x)
76− Remove e x -> get "_N.remove" `call` [ref x, expression e]
77+ Remove e x -> get "_N.remove" `call` [string x, expression e]
77− Insert e x v -> get "_N.insert" `call` [ref x, expression v, expression e]
78+ Insert e x v -> get "_N.insert" `call` [string x, expression v, expression e]
78 Modify e fs ->
79 Modify e fs ->
79− let modify (f,v) = ArrayLit () [ref f, expression e]
80+ let modify (f,v) = ArrayLit () [string f, expression v]
80 in get "_N.replace" `call` [ArrayLit () (map modify fs), expression e]
81 in get "_N.replace" `call` [ArrayLit () (map modify fs), expression e]
81
82
82 Record fields -> ObjectLit () $ (PropId () (var "_"), hidden) : visible
83 Record fields -> ObjectLit () $ (PropId () (var "_"), hidden) : visible
@@ -183,7 +184,7 @@ definition def =
183 vars = getVars patterns
184 vars = getVars patterns
184 getVars patterns =
185 getVars patterns =
185 case patterns of
186 case patterns of
186− PVar x : rest -> (x:) <$> getVars rest
187+ PVar x : rest -> (x:) `fmap` getVars rest
187 [] -> Just []
188 [] -> Just []
188 _ -> Nothing
189 _ -> Nothing
189
190
@@ -236,13 +237,13 @@ clause span variable (Clause value vars mtch) =
236 [] -> name
237 [] -> name
237 is -> drop (last is + 1) name
238 is -> drop (last is + 1) name
238
239
239−jsModule :: MetadataModule () () -> [Statement ()]
240+jsModule :: MetadataModule () () -> String -- [Statement ()]
240−jsModule modul = setup ("Elm" : names modul) ++
241+jsModule modul = show . prettyPrint $ setup (Just "Elm") (names modul) ++
241− [ assign ("Elm" : names modul) (function ["elm"] programStmts) ]
242+ [ assign ("Elm" : names modul) (function ["elm"] programStmts) ]
242 where
243 where
243 thisModule = dotSep ("elm" : names modul)
244 thisModule = dotSep ("elm" : names modul)
244 programStmts =
245 programStmts =
245− concat [ setup ("elm" : names modul)
246+ concat [ setup (Just "elm") (names modul)
246 , [ IfSingleStmt () thisModule (ReturnStmt () (Just thisModule)) ]
247 , [ IfSingleStmt () thisModule (ReturnStmt () (Just thisModule)) ]
247 , [ internalImports (List.intercalate "." (names modul)) ]
248 , [ internalImports (List.intercalate "." (names modul)) ]
248 , concatMap jsImport (imports modul)
249 , concatMap jsImport (imports modul)
@@ -260,20 +261,21 @@ jsModule modul = setup ("Elm" : names modul) ++
260 entry x = (PropId () (var x), ref x)
261 entry x = (PropId () (var x), ref x)
261
262
262 assign path expr =
263 assign path expr =
263− ExprStmt () $
264− flip (AssignExpr () OpAssign) expr $
265 case path of
264 case path of
266− [x] -> LVar () x
265+ [x] -> VarDeclStmt () [ varDecl x expr ]
266+ _ -> ExprStmt () $
267− _ -> LDot () (dotSep (init path)) (last path)
267+ AssignExpr () OpAssign (LDot () (dotSep (init path)) (last path)) expr
268
268
269− jsImport (modul,_) = setup path ++ [ assign path (dotSep path <| ref "elm") ]
269+ jsImport (modul,_) = setup Nothing path ++ [ assign path (dotSep ("Elm" : path) <| ref "elm") ]
270 where
270 where
271 path = split modul
271 path = split modul
272
272
273− setup path = map create paths
273+ setup namespace path = map create paths
274 where
274 where
275 create name = assign name (InfixExpr () OpLOr (dotSep name) (ObjectLit () []))
275 create name = assign name (InfixExpr () OpLOr (dotSep name) (ObjectLit () []))
276+ paths = case namespace of
277+ Nothing -> tail . init $ List.inits path
276− paths = drop 2 . init $ List.inits path
278+ Just nmspc -> drop 2 . init . List.inits $ nmspc : path
277
279
278 addId js = InfixExpr () OpAdd (string (js++"_")) (get "elm.id")
280 addId js = InfixExpr () OpAdd (string (js++"_")) (get "elm.id")
279
281
@@ -328,7 +330,7 @@ binop span op e1 e2 =
328
330
329 opDict = Map.fromList (infixOps ++ specialOps)
331 opDict = Map.fromList (infixOps ++ specialOps)
330
332
331− specialOp str func = ("Basic." ++ str, func)
333+ specialOp str func = ("Basics." ++ str, func)
332 infixOp str op = specialOp str (InfixExpr () op)
334 infixOp str op = specialOp str (InfixExpr () op)
333
335
334 infixOps =
336 infixOps =
compiler/Parse/Helpers.hs+1−9
@@ -64,18 +64,10 @@ rLabel = lowVar
64innerVarChar :: IParser Char
64innerVarChar :: IParser Char
65innerVarChar = alphaNum <|> char '_' <|> char '\'' <?> ""
65innerVarChar = alphaNum <|> char '_' <|> char '\'' <?> ""
66
66
67−makeSafe :: String -> String
68−makeSafe = dereserve . deprime
69− where
70− deprime = map (\c -> if c == '\'' then '$' else c)
71− dereserve x = case Set.member x jsReserveds of
72− False -> x
73− True -> "$" ++ x
74−
75makeVar :: IParser Char -> IParser String
67makeVar :: IParser Char -> IParser String
76makeVar p = do v <- (:) <$> p <*> many innerVarChar
68makeVar p = do v <- (:) <$> p <*> many innerVarChar
77 guard (v `notElem` reserveds)
69 guard (v `notElem` reserveds)
78− return (makeSafe v)
70+ return v
79
71
80reserved :: String -> IParser String
72reserved :: String -> IParser String
81reserved word =
73reserved word =