aca96b2 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

on golang help sign in

Comments, type synonyms for better documentation

aca96b2Gary Burgess11 years ago

psc-make/Main.hs+2−2

compare with golang

unifiedsplit

@@ -78,8 +78,8 @@ readInput InputOptions{..} = forM ioInputFiles $ \inFile -> (Right inFile, ) <$>

79parseInputs :: (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m)

80 => [(Either P.RebuildPolicy FilePath, String)]

81− -> [(FilePath, String)]

81+ -> [(FilePath, P.ForeignJS)]

82− -> m ([(Either P.RebuildPolicy FilePath, P.Module)], M.Map P.ModuleName String)

82+ -> m ([(Either P.RebuildPolicy FilePath, P.Module)], M.Map P.ModuleName P.ForeignJS)

83parseInputs modules foreigns =

84 (,) <$> P.parseModulesFromFiles (either (const "") id) modules

85 <*> P.parseForeignModulesFromFiles foreigns

psc-make/Make.hs+3−3

@@ -64,7 +64,7 @@ traverseEither f (Right y) = Right <$> f y

65buildMakeActions :: FilePath

66 -> M.Map P.ModuleName (Either P.RebuildPolicy String)

67− -> M.Map P.ModuleName String

67+ -> M.Map P.ModuleName P.ForeignJS

68 -> Bool

69 -> P.MakeActions Make

70buildMakeActions outputDir filePathMap foreigns usePrefix =

@@ -88,8 +88,8 @@ buildMakeActions outputDir filePathMap foreigns usePrefix =

88 let path = outputDir </> P.runModuleName mn </> "externs.purs"

89 (path, ) <$> readTextFile path

91− codegen :: CF.Module CF.Ann -> String -> P.Environment -> Integer -> Make ()

91+ codegen :: CF.Module CF.Ann -> P.Environment -> P.SupplyVar -> P.Externs -> Make ()

92− codegen m exts _ nextVar = do

92+ codegen m _ nextVar exts = do

93 foreignInclude <- case CF.moduleName m `M.lookup` foreigns of

94 Just _ | not $ requiresForeign m -> error "Found unnecessary foreign module"

95 | otherwise -> return $ Just $ J.JSApp (J.JSVar "require") [J.JSStringLiteral "./foreign"]

psc/Main.hs+3−3

@@ -99,15 +99,15 @@ compile (PSCOptions input inputForeign opts stdin output externs usePrefix) = do

99 exitSuccess

100

101parseInputs :: (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m)

102− => [(Maybe FilePath, String)] -> [(FilePath, String)] -> m ([(Maybe FilePath, P.Module)], M.Map P.ModuleName String)

102+ => [(Maybe FilePath, String)] -> [(FilePath, P.ForeignJS)] -> m ([(Maybe FilePath, P.Module)], M.Map P.ModuleName String)

103parseInputs modules foreigns =

104 (,) <$> P.parseModulesFromFiles (fromMaybe "") modules

105 <*> P.parseForeignModulesFromFiles foreigns

106

107compileJS :: forall m. (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m, MonadReader (P.Options P.Compile) m)

108− => [P.Module] -> M.Map P.ModuleName String -> [String] -> m (String, String)

108+ => [P.Module] -> M.Map P.ModuleName P.ForeignJS -> [String] -> m (String, String)

109compileJS ms foreigns prefix = do

110− (modulesToCodeGen, exts, env, nextVar) <- P.compile ms

110+ (modulesToCodeGen, env, nextVar, exts) <- P.compile ms

111 js <- concat <$> evalSupplyT nextVar (traverse codegenModule modulesToCodeGen)

112 js' <- generateMain env js

113 let pjs = unlines $ map ("// " ++) prefix ++ [P.prettyPrintJS js']

src/Language/PureScript.hs+47−38

@@ -24,6 +24,8 @@ module Language.PureScript

24 , compile'

25 , RebuildPolicy(..)

26 , MakeActions(..)

27+ , SupplyVar()

28+ , Externs()

27 , make

29 , make

28 , version

30 , version

29 ) where

31 ) where

@@ -46,7 +48,7 @@ import Control.Monad.Supply.Class (fresh)

47import Language.PureScript.AST as P

49import Language.PureScript.AST as P

48import Language.PureScript.Comments as P

50import Language.PureScript.Comments as P

49−import Language.PureScript.CodeGen

51+import Language.PureScript.CodeGen.Externs (moduleToPs)

50import Language.PureScript.DeadCodeElimination as P

52import Language.PureScript.DeadCodeElimination as P

51import Language.PureScript.Environment as P

53import Language.PureScript.Environment as P

52import Language.PureScript.Errors as P

54import Language.PureScript.Errors as P

@@ -87,11 +89,11 @@ import qualified Paths_purescript as Paths

87-- * Pretty-print the generated Javascript

89-- * Pretty-print the generated Javascript

88--

90--

89compile :: (Functor m, Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadReader (Options Compile) m)

91compile :: (Functor m, Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadReader (Options Compile) m)

90− => [Module] -> m ([CoreFn.Module CoreFn.Ann], String, Environment, Integer)

92+ => [Module] -> m ([CoreFn.Module CoreFn.Ann], Environment, SupplyVar, Externs)

91compile = compile' initEnvironment

93compile = compile' initEnvironment

93compile' :: (Functor m, Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadReader (Options Compile) m)

95compile' :: (Functor m, Applicative m, MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadReader (Options Compile) m)

94− => Environment -> [Module] -> m ([CoreFn.Module CoreFn.Ann], String, Environment, Integer)

96+ => Environment -> [Module] -> m ([CoreFn.Module CoreFn.Ann], Environment, SupplyVar, Externs)

95compile' env ms = do

97compile' env ms = do

96 noPrelude <- asks optionsNoPrelude

98 noPrelude <- asks optionsNoPrelude

97 unless noPrelude (checkPreludeIsDefined ms)

99 unless noPrelude (checkPreludeIsDefined ms)

@@ -108,40 +110,48 @@ compile' env ms = do

108 renamed = renameInModules elim

110 renamed = renameInModules elim

109 codeGenModuleNames = moduleNameFromString `map` codeGenModules additional

111 codeGenModuleNames = moduleNameFromString `map` codeGenModules additional

110 modulesToCodeGen = if null codeGenModuleNames then renamed else filter (\(CoreFn.Module _ mn _ _ _ _) -> mn `elem` codeGenModuleNames) renamed

112 modulesToCodeGen = if null codeGenModuleNames then renamed else filter (\(CoreFn.Module _ mn _ _ _ _) -> mn `elem` codeGenModuleNames) renamed

111− let exts = intercalate "\n" . map (`moduleToPs` env') $ regrouped

113+ exts = intercalate "\n" . map (`moduleToPs` env') $ regrouped

112− return (modulesToCodeGen, exts, env', nextVar)

114+ return (modulesToCodeGen, env', nextVar, exts)

113

115

114-- |

116-- |

115−-- A type class which collects the IO actions we need to be able to run in "make" mode

117+-- Actions that require implementations when running in "make" mode.

116−--

117−--class (MonadReader (P.Options P.Make) m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) => MonadMake m where

118−-- -- |

119−-- -- Get a file timestamp

120−-- --

121−-- getTimestamp :: FilePath -> m (Maybe UTCTime)

122−

123−-- -- |

124−-- -- Read a file as a string

125−-- --

126−-- readTextFile :: FilePath -> m String

127−

128−-- -- |

129−-- -- Write a text file

130−-- --

131−-- writeTextFile :: FilePath -> String -> m ()

132−

133−-- -- |

118+--

134−-- -- Respond to a progress update

135−-- --

136−-- progress :: String -> m ()

137−

138−data MakeActions m = MakeActions

119+data MakeActions m = MakeActions {

120+ -- |

121+ -- Get the timestamp for the input file(s) for a module. If there are multiple

122+ -- files (.purs and foreign files, for example) the timestamp should be for

123+ -- the most recently modified file.

124+ --

139− { getInputTimestamp :: ModuleName -> m (Either RebuildPolicy (Maybe UTCTime))

125+ getInputTimestamp :: ModuleName -> m (Either RebuildPolicy (Maybe UTCTime))

126+ -- |

127+ -- Get the timestamp for the output files for a module. This should be the

128+ -- timestamp for the oldest modified file, or Nothing if any of the required

129+ -- output files are missing.

130+ --

140− , getOutputTimestamp :: ModuleName -> m (Maybe UTCTime)

131+ , getOutputTimestamp :: ModuleName -> m (Maybe UTCTime)

132+ -- |

133+ -- Read the externs file for a module as a string and also return the actual

134+ -- path for the file.

141− , readExterns :: ModuleName -> m (FilePath, String)

135+ , readExterns :: ModuleName -> m (FilePath, String)

136+ -- |

137+ -- Run the code generator for the module and write any required output files.

138+ --

142− , codegen :: CoreFn.Module CoreFn.Ann -> String -> Environment -> Integer -> m ()

139+ , codegen :: CoreFn.Module CoreFn.Ann -> Environment -> SupplyVar -> Externs -> m ()

143− , progress :: String -> m ()

140+ -- |

144− }

141+ -- Respond to a progress update.

142+ --

143+ , progress :: String -> m ()

144+ }

145+

146+-- |

147+-- Generated code for an externs file.

148+--

149+type Externs = String

150+

151+-- |

152+-- A value to be used in the Supply monad.

153+--

154+type SupplyVar = Integer

145

155

146-- |

156-- |

147-- Determines when to rebuild a module

157-- Determines when to rebuild a module

@@ -186,16 +196,15 @@ make MakeActions{..} ms = do

186 (_, env') <- lift . runCheck' env $ typeCheckModule Nothing m

196 (_, env') <- lift . runCheck' env $ typeCheckModule Nothing m

187 go env' ms'

197 go env' ms'

188 go env ((True, m@(Module coms moduleName' _ exps)) : ms') = do

198 go env ((True, m@(Module coms moduleName' _ exps)) : ms') = do

189−

190 lift $ progress $ "Compiling " ++ runModuleName moduleName'

199 lift $ progress $ "Compiling " ++ runModuleName moduleName'

191 (Module _ _ elaborated _, env') <- lift . runCheck' env $ typeCheckModule Nothing m

200 (Module _ _ elaborated _, env') <- lift . runCheck' env $ typeCheckModule Nothing m

192 regrouped <- createBindingGroups moduleName' . collapseBindingGroups $ elaborated

201 regrouped <- createBindingGroups moduleName' . collapseBindingGroups $ elaborated

193 let mod' = Module coms moduleName' regrouped exps

202 let mod' = Module coms moduleName' regrouped exps

194 corefn = CoreFn.moduleToCoreFn env' mod'

203 corefn = CoreFn.moduleToCoreFn env' mod'

195 [renamed] = renameInModules [corefn]

204 [renamed] = renameInModules [corefn]

196− let exts = moduleToPs mod' env'

205+ exts = moduleToPs mod' env'

197 nextVar <- fresh

206 nextVar <- fresh

198− lift $ codegen renamed exts env' nextVar

207+ lift $ codegen renamed env' nextVar exts

199 go env' ms'

208 go env' ms'

200

209

201 rebuildIfNecessary :: M.Map ModuleName [ModuleName] -> S.Set ModuleName -> [Module] -> m [(Bool, Module)]

210 rebuildIfNecessary :: M.Map ModuleName [ModuleName] -> S.Set ModuleName -> [Module] -> m [(Bool, Module)]

src/Language/PureScript/Parser/JS.hs+7−2

@@ -14,7 +14,10 @@

15{-# LANGUAGE FlexibleContexts #-}

17−module Language.PureScript.Parser.JS (parseForeignModulesFromFiles) where

17+module Language.PureScript.Parser.JS

18+ ( ForeignJS()

19+ , parseForeignModulesFromFiles

20+ ) where

19import Control.Applicative ((*>), (<*))

22import Control.Applicative ((*>), (<*))

20import Control.Monad (msum)

23import Control.Monad (msum)

@@ -27,7 +30,9 @@ import Prelude hiding (lex)

27import qualified Data.Map as M

30import qualified Data.Map as M

28import qualified Text.Parsec as PS

31import qualified Text.Parsec as PS

33+type ForeignJS = String

34+

30−parseForeignModulesFromFiles :: (MonadError MultipleErrors m, Functor m) => [(FilePath, String)] -> m (M.Map ModuleName String)

35+parseForeignModulesFromFiles :: (MonadError MultipleErrors m, Functor m) => [(FilePath, ForeignJS)] -> m (M.Map ModuleName ForeignJS)

31parseForeignModulesFromFiles files = do

36parseForeignModulesFromFiles files = do

32 foreigns <- parU files $ \(path, file) ->

37 foreigns <- parU files $ \(path, file) ->

33 case findModuleName (lines file) of

38 case findModuleName (lines file) of