8488894 · rowtype-yoga/purescript-native

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

on golang help sign in

Fix #186

8488894Phil Freeman13 years ago

src/Language/PureScript/CodeGen/JS.hs+26−6

compare with golang

unifiedsplit

@@ -25,6 +25,8 @@ module Language.PureScript.CodeGen.JS (

25import Data.Maybe (fromMaybe, mapMaybe)

26import Data.List (sortBy)

27import Data.Function (on)

28+import Data.Data (Data)

29+import Data.Generics (mkQ, everything)

29import Control.Arrow (second)

31import Control.Arrow (second)

30import Control.Monad (replicateM, forM)

32import Control.Monad (replicateM, forM)

@@ -143,11 +145,20 @@ valueToJs _ _ _ (TypeClassDictionary _ _) = error "Type class dictionary was not

143valueToJs _ _ _ _ = error "Invalid argument to valueToJs"

145valueToJs _ _ _ _ = error "Invalid argument to valueToJs"

144

146

145-- |

147-- |

146−-- Temporarily extends the environment to include a local variable name introduced by a lambda

148+-- Temporarily extends the environment with a single local variable name

147−-- abstraction.

148--

149--

149bindName :: ModuleName -> Ident -> Environment -> Environment

150bindName :: ModuleName -> Ident -> Environment -> Environment

151+bindName m ident = bindNames m [ident]

152+

153+-- |

154+-- Temporarily extends the environment to include local variable names introduced by lambda

155+-- abstractions or case statements

156+--

157+bindNames :: ModuleName -> [Ident] -> Environment -> Environment

158+bindNames m idents env = env { names = M.fromList [ ((m, ident), (noType, LocalVariable)) | ident <- idents ] `M.union` names env }

159+ where

150−bindName m ident env = env { names = M.insert (m, ident) (error "Temporary lambda variable type was read", LocalVariable) $ names env }

160+ noType = error "Temporary lambda variable type was read"

161+

151

162

152-- |

163-- |

153-- Generate code in the simplified Javascript intermediate representation for runtime type checks.

164-- Generate code in the simplified Javascript intermediate representation for runtime type checks.

@@ -215,7 +226,7 @@ qualifiedToJS f (Qualified Nothing a) = JSVar $ identToJs (f a)

215bindersToJs :: Options -> ModuleName -> Environment -> [([Binder], Maybe Guard, Value)] -> [JS] -> JS

226bindersToJs :: Options -> ModuleName -> Environment -> [([Binder], Maybe Guard, Value)] -> [JS] -> JS

216bindersToJs opts m e binders vals = runGen (map identToJs (unusedNames (binders, vals))) $ do

227bindersToJs opts m e binders vals = runGen (map identToJs (unusedNames (binders, vals))) $ do

217 valNames <- replicateM (length vals) fresh

228 valNames <- replicateM (length vals) fresh

218− jss <- forM binders $ \(bs, grd, result) -> go valNames [JSReturn (valueToJs opts m e result)] bs grd

229+ jss <- forM binders $ \(bs, grd, result) -> go valNames [JSReturn (valueToJs opts m (bindNames m (binderNames bs) e) result)] bs grd

219 return $ JSApp (JSFunction Nothing valNames (JSBlock (concat jss ++ [JSThrow (JSStringLiteral "Failed pattern match")])))

230 return $ JSApp (JSFunction Nothing valNames (JSBlock (concat jss ++ [JSThrow (JSStringLiteral "Failed pattern match")])))

220 vals

231 vals

221 where

232 where

@@ -227,6 +238,15 @@ bindersToJs opts m e binders vals = runGen (map identToJs (unusedNames (binders,

227 binderToJs m e v done'' b

238 binderToJs m e v done'' b

228 go _ _ _ _ = error "Invalid arguments to bindersToJs"

239 go _ _ _ _ = error "Invalid arguments to bindersToJs"

229

240

241+-- |

242+-- Collect all names introduced in binders in an expression

243+--

244+binderNames :: (Data d) => d -> [Ident]

245+binderNames = everything (++) (mkQ [] go)

246+ where

247+ go (VarBinder ident) = [ident]

248+ go _ = []

249+

230-- |

250-- |

231-- Generate code in the simplified Javascript intermediate representation for a pattern match

251-- Generate code in the simplified Javascript intermediate representation for a pattern match

232-- binder.

252-- binder.

@@ -241,7 +261,7 @@ binderToJs _ _ varName done (BooleanBinder True) =

241 return [JSIfElse (JSVar varName) (JSBlock done) Nothing]

261 return [JSIfElse (JSVar varName) (JSBlock done) Nothing]

242binderToJs _ _ varName done (BooleanBinder False) =

262binderToJs _ _ varName done (BooleanBinder False) =

243 return [JSIfElse (JSUnary Not (JSVar varName)) (JSBlock done) Nothing]

263 return [JSIfElse (JSUnary Not (JSVar varName)) (JSBlock done) Nothing]

244−binderToJs _ _ varName done (VarBinder ident) =

264+binderToJs m e varName done (VarBinder ident) =

245 return (JSVariableIntroduction (identToJs ident) (Just (JSVar varName)) : done)

265 return (JSVariableIntroduction (identToJs ident) (Just (JSVar varName)) : done)

246binderToJs m e varName done (NullaryBinder ctor) =

266binderToJs m e varName done (NullaryBinder ctor) =

247 if isOnlyConstructor m e ctor

267 if isOnlyConstructor m e ctor

@@ -296,7 +316,7 @@ binderToJs m e varName done (NamedBinder ident binder) = do

296

316

297-- |

317-- |

298-- Checks whether a data constructor is the only constructor for that type, used to simplify the

318-- Checks whether a data constructor is the only constructor for that type, used to simplify the

299−-- check when generating code for binders.

319+-- check when generating code for binders.

300--

320--

301isOnlyConstructor :: ModuleName -> Environment -> Qualified ProperName -> Bool

321isOnlyConstructor :: ModuleName -> Environment -> Qualified ProperName -> Bool

302isOnlyConstructor m e ctor =

322isOnlyConstructor m e ctor =