git.iko.soy/Idris-dev
on master help sign in
Simplify JS code generation
311e3beThomas Scholtes
CONTRIBUTORS+1
compare with master
unifiedsplit
@@ -200,6 +200,7 @@ Sven Koschnicke
200tdidriksen
200tdidriksen
201Tenor Biel
201Tenor Biel
202Thomas Cooper
202Thomas Cooper
203+Thomas Scholtes
203Tim Dysinger
204Tim Dysinger
204Tim McGilchrist
205Tim McGilchrist
205Timo Petteri Sinnemäki
206Timo Petteri Sinnemäki
src/IRTS/JavaScript/Codegen.hs+32−21
@@ -25,10 +25,12 @@ import IRTS.System
25
25
26import Control.Monad
26import Control.Monad
27import Control.Monad.Trans.State
27import Control.Monad.Trans.State
28+import Data.Foldable (foldMap)
28import Data.List (nub)
29import Data.List (nub)
29import Data.Map.Strict (Map)
30import Data.Map.Strict (Map)
30import qualified Data.Map.Strict as Map
31import qualified Data.Map.Strict as Map
31import Data.Maybe (fromJust)
32import Data.Maybe (fromJust)
33+import Data.Monoid
32import Data.Set (Set)
34import Data.Set (Set)
33import qualified Data.Set as Set
35import qualified Data.Set as Set
34import Data.Text (Text)
36import Data.Text (Text)
@@ -45,16 +47,26 @@ import Data.Generics.Uniplate.Data
45import Data.List
47import Data.List
46import GHC.Generics (Generic)
48import GHC.Generics (Generic)
47
49
50+-- | Code generation stats hold information about the generated user
51+-- code. Based on that information we add additional code to make
52+-- things work.
48data CGStats = CGStats { usedBigInt :: Bool
53data CGStats = CGStats { usedBigInt :: Bool
49 , partialApplications :: Set Partial
54 , partialApplications :: Set Partial
50 , hiddenClasses :: Set HiddenClass
55 , hiddenClasses :: Set HiddenClass
51 }
56 }
52
57
53−emptyStats :: CGStats
58+-- If we generate code for two declarations we want to merge their code
59+-- generation stats.
60+instance Monoid CGStats where
54−emptyStats = CGStats { partialApplications = Set.empty
61+ mempty = CGStats { partialApplications = Set.empty
55− , hiddenClasses = Set.empty
62+ , hiddenClasses = Set.empty
56− , usedBigInt = False
63+ , usedBigInt = False
57− }
64+ }
65+ mappend x y = CGStats { partialApplications = partialApplications x `Set.union` partialApplications y
66+ , hiddenClasses = hiddenClasses x `Set.union` hiddenClasses y
67+ , usedBigInt = usedBigInt x || usedBigInt y
68+ }
69+
58
70
59data CGConf = CGConf { header :: Text
71data CGConf = CGConf { header :: Text
60 , footer :: Text
72 , footer :: Text
@@ -101,11 +113,9 @@ codegenJs conf ci =
101 let defs' = Map.fromList $ liftDecls ci
113 let defs' = Map.fromList $ liftDecls ci
102 let defs = globlToCon defs'
114 let defs = globlToCon defs'
103 let used = Map.elems $ removeDeadCode defs [sMN 0 "runMain"]
115 let used = Map.elems $ removeDeadCode defs [sMN 0 "runMain"]
104− if debug then
116+ when debug $ do
105− do
106 writeFile (outputFile ci ++ ".LDeclsDebug") $ (unlines $ intersperse "" $ map show used) ++ "\n\n\n"
117 writeFile (outputFile ci ++ ".LDeclsDebug") $ (unlines $ intersperse "" $ map show used) ++ "\n\n\n"
107 putStrLn $ "Finished calculating used"
118 putStrLn $ "Finished calculating used"
108− else pure ()
109
119
110 let (out, stats) = doCodegen conf defs used
120 let (out, stats) = doCodegen conf defs used
111
121
@@ -160,20 +170,21 @@ doHiddenClasses x =
160 JsFun (jsNameHiddenClass p) vars $ JsSeq (JsSet (JsProp JsThis "type") (JsInt id)) $ seqJs
170 JsFun (jsNameHiddenClass p) vars $ JsSeq (JsSet (JsProp JsThis "type") (JsInt id)) $ seqJs
161 $ map (\tv -> JsSet (JsProp JsThis tv) (JsVar tv)) vars
171 $ map (\tv -> JsSet (JsProp JsThis tv) (JsVar tv)) vars
162
172
173+
174+-- | Generate code for each declaration and collect stats.
175+-- LFunctions are turned into JS function declarations. They are
176+-- preceded by a comment that gives their name. Constructor
177+-- declarations are ignored.
163doCodegen :: CGConf -> Map Name LDecl -> [LDecl] -> (Text, CGStats)
178doCodegen :: CGConf -> Map Name LDecl -> [LDecl] -> (Text, CGStats)
164−doCodegen conf defs decls =
165− let xs = map (doCodegenDecl conf defs) decls
179+doCodegen conf defs decls = foldMap (doCodegenDecl conf defs) decls
166− groupCGStats x y = CGStats { partialApplications = partialApplications x `Set.union` partialApplications y
180+ where
167− , hiddenClasses = hiddenClasses x `Set.union` hiddenClasses y
168− , usedBigInt = usedBigInt x || usedBigInt y
169− }
170− in (T.intercalate "\n" $ map fst xs, foldl' groupCGStats emptyStats (map snd xs) )
171−
172−doCodegenDecl :: CGConf -> Map Name LDecl -> LDecl -> (Text, CGStats)
181+ doCodegenDecl :: CGConf -> Map Name LDecl -> LDecl -> (Text, CGStats)
173−doCodegenDecl conf defs (LFun _ n args def) =
182+ doCodegenDecl conf defs (LFun _ name args def) =
174− let (ast, stats) = cgFun conf defs n args def
183+ let (ast, stats) = cgFun conf defs name args def
175− in (T.concat [jsStmt2Text (JsComment $ T.pack $ show n), "\n", jsStmt2Text ast], stats)
184+ fnComment = jsStmt2Text (JsComment $ T.pack $ show name)
185+ in (T.concat [fnComment, "\n", jsStmt2Text ast, "\n"], stats)
176−doCodegenDecl conf defs (LConstructor n i sz) = ("", emptyStats)
186+ doCodegenDecl conf defs (LConstructor n i sz) = ("", mempty)
187+
177
188
178seqJs :: [JsStmt] -> JsStmt
189seqJs :: [JsStmt] -> JsStmt
179seqJs [] = JsEmpty
190seqJs [] = JsEmpty