git.iko.soy/Idris-dev
on master help sign in
changed names to camelcase
cb85d5eRui Barreiro
src/IRTS/JavaScript/AST.hs+2−2
compare with master
unifiedsplit
@@ -9,7 +9,7 @@ Maintainer : The Idris Community.
9
9
10module IRTS.JavaScript.AST( JsAST(..)
10module IRTS.JavaScript.AST( JsAST(..)
11 , jsAst2Text
11 , jsAst2Text
12− , js_aux_defs
12+ , jsAuxDefs
13 ) where
13 ) where
14
14
15import Data.Char
15import Data.Char
@@ -214,7 +214,7 @@ force = T.concat [ "var js_idris_force = function (x){\n"
214 , "}\n\n"
214 , "}\n\n"
215 ]
215 ]
216
216
217−js_aux_defs = T.concat [throw2, force]
217+jsAuxDefs = T.concat [throw2, force]
218
218
219default2Text :: Maybe JsAST -> Text
219default2Text :: Maybe JsAST -> Text
220default2Text Nothing = ""
220default2Text Nothing = ""
src/IRTS/JavaScript/Codegen.hs+8−8
@@ -59,12 +59,12 @@ data CGConf = CGConf { header :: Text
59 }
59 }
60
60
61
61
62−get_include :: FilePath -> IO Text
62+getInclude :: FilePath -> IO Text
63−get_include p = TIO.readFile p
63+getInclude p = TIO.readFile p
64
64
65−get_includes :: [FilePath] -> IO Text
65+getIncludes :: [FilePath] -> IO Text
66−get_includes l = do
66+getIncludes l = do
67− incs <- mapM get_include l
67+ incs <- mapM getInclude l
68 return $ T.intercalate "\n\n" incs
68 return $ T.intercalate "\n\n" incs
69
69
70isYes :: Maybe String -> Bool
70isYes :: Maybe String -> Bool
@@ -83,7 +83,7 @@ codegenJs conf ci =
83 else putStrLn "compiling widthout idris-js optimizations"
83 else putStrLn "compiling widthout idris-js optimizations"
84 else pure ()
84 else pure ()
85 let defs = Map.fromList $ liftDecls ci
85 let defs = Map.fromList $ liftDecls ci
86− let used = Map.elems $ used_defs defs [sMN 0 "runMain"]
86+ let used = Map.elems $ removeDeadCode defs [sMN 0 "runMain"]
87 if debug then
87 if debug then
88 do
88 do
89 writeFile (outputFile ci ++ ".LDeclsDebug") $ (unlines $ intersperse "" $ map show used) ++ "\n\n\n"
89 writeFile (outputFile ci ++ ".LDeclsDebug") $ (unlines $ intersperse "" $ map show used) ++ "\n\n\n"
@@ -98,7 +98,7 @@ codegenJs conf ci =
98 else return ""
98 else return ""
99
99
100
100
101− includes <- get_includes $ includes ci
101+ includes <- getIncludes $ includes ci
102 TIO.writeFile (outputFile ci) $ T.concat [ header conf
102 TIO.writeFile (outputFile ci) $ T.concat [ header conf
103 , "\"use strict\";\n\n"
103 , "\"use strict\";\n\n"
104 , "(function(){\n\n"
104 , "(function(){\n\n"
@@ -106,7 +106,7 @@ codegenJs conf ci =
106 , initialization conf stats
106 , initialization conf stats
107 , doPartials (partialApplications stats)
107 , doPartials (partialApplications stats)
108 , includes, "\n"
108 , includes, "\n"
109− , js_aux_defs, "\n"
109+ , jsAuxDefs, "\n"
110 , out, "\n"
110 , out, "\n"
111 , "\n"
111 , "\n"
112 , jsName (sMN 0 "runMain"), "();\n\n"
112 , jsName (sMN 0 "runMain"), "();\n\n"
src/IRTS/JavaScript/LangTransforms.hs+21−21
@@ -5,10 +5,10 @@ Copyright :
5License : BSD3
5License : BSD3
6Maintainer : The Idris Community.
6Maintainer : The Idris Community.
7-}
7-}
8−{-# LANGUAGE DeriveDataTypeable, DeriveGeneric,
8+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, FlexibleInstances,
9− FlexibleInstances, OverloadedStrings, StandaloneDeriving #-}
9+ OverloadedStrings, StandaloneDeriving #-}
10
10
11−module IRTS.JavaScript.LangTransforms( used_defs
11+module IRTS.JavaScript.LangTransforms( removeDeadCode
12 ) where
12 ) where
13
13
14
14
@@ -56,33 +56,33 @@ mapMapListKeys _ [] x = x
56mapMapListKeys f (t:r) x = mapMapListKeys f r $ Map.adjust f t x
56mapMapListKeys f (t:r) x = mapMapListKeys f r $ Map.adjust f t x
57
57
58
58
59−extract_globs :: Map Name LDecl -> LDecl -> [Name]
59+extractGlobs :: Map Name LDecl -> LDecl -> [Name]
60−extract_globs defs (LConstructor _ _ _) = []
60+extractGlobs defs (LConstructor _ _ _) = []
61−extract_globs defs (LFun _ _ _ e) =
61+extractGlobs defs (LFun _ _ _ e) =
62 let f (LV (Glob x)) = Just x
62 let f (LV (Glob x)) = Just x
63 f (LLazyApp x _) = Just x
63 f (LLazyApp x _) = Just x
64 f _ = Nothing
64 f _ = Nothing
65 in [x | Just x <- map f $ universe e, Map.member x defs]
65 in [x | Just x <- map f $ universe e, Map.member x defs]
66
66
67−used_functions :: Map Name LDecl -> Set Name -> [Name] -> [Name]
67+usedFunctions :: Map Name LDecl -> Set Name -> [Name] -> [Name]
68−used_functions _ _ [] = []
68+usedFunctions _ _ [] = []
69−used_functions alldefs done names =
69+usedFunctions alldefs done names =
70 let decls = catMaybes $ map (\x -> Map.lookup x alldefs) names
70 let decls = catMaybes $ map (\x -> Map.lookup x alldefs) names
71− used_names = (nub $ concat $ map (extract_globs alldefs) decls) \\ names
71+ used_names = (nub $ concat $ map (extractGlobs alldefs) decls) \\ names
72 new_names = filter (\x -> not $ Set.member x done) used_names
72 new_names = filter (\x -> not $ Set.member x done) used_names
73− in used_names ++ used_functions alldefs (Set.union done $ Set.fromList new_names) new_names
73+ in used_names ++ usedFunctions alldefs (Set.union done $ Set.fromList new_names) new_names
74
74
75
75
76−used_decls :: Map Name LDecl -> [Name] -> Map Name LDecl
76+usedDecls :: Map Name LDecl -> [Name] -> Map Name LDecl
77−used_decls dcls start =
77+usedDecls dcls start =
78− let used = reverse $ start ++ used_functions dcls (Set.fromList start) start
78+ let used = reverse $ start ++ usedFunctions dcls (Set.fromList start) start
79 in restrictKeys dcls (Set.fromList used) --catMaybes $ map (\x -> Map.lookup x dcls) used
79 in restrictKeys dcls (Set.fromList used) --catMaybes $ map (\x -> Map.lookup x dcls) used
80
80
81getUsedConstructors :: Map Name LDecl -> Set Name
81getUsedConstructors :: Map Name LDecl -> Set Name
82getUsedConstructors x = Set.fromList [ n | LCon _ _ n _ <- universeBi x]
82getUsedConstructors x = Set.fromList [ n | LCon _ _ n _ <- universeBi x]
83
83
84−remove_unused_branches :: Set Name -> Map Name LDecl -> Map Name LDecl
84+removeUnusedBranches :: Set Name -> Map Name LDecl -> Map Name LDecl
85−remove_unused_branches used x =
85+removeUnusedBranches used x =
86 transformBi f x
86 transformBi f x
87 where
87 where
88 f :: [LAlt] -> [LAlt]
88 f :: [LAlt] -> [LAlt]
@@ -91,9 +91,9 @@ remove_unused_branches used x =
91 else r
91 else r
92 f x = x
92 f x = x
93
93
94−used_defs :: Map Name LDecl -> [Name] -> Map Name LDecl
94+removeDeadCode :: Map Name LDecl -> [Name] -> Map Name LDecl
95−used_defs dcls start =
95+removeDeadCode dcls start =
96− let used = used_decls dcls start
96+ let used = usedDecls dcls start
97− remCons = remove_unused_branches (getUsedConstructors used) used
97+ remCons = removeUnusedBranches (getUsedConstructors used) used
98 in if Map.keys remCons == Map.keys dcls then remCons
98 in if Map.keys remCons == Map.keys dcls then remCons
99− else used_defs remCons start
99+ else removeDeadCode remCons start