@@ -25,8 +25,7 @@ module Language.PureScript.CodeGen.JS (
25import Data.Maybe (fromMaybe, mapMaybe)
25import Data.Maybe (fromMaybe, mapMaybe)
26import Data.Function (on)
26import Data.Function (on)
28−import Control.Applicative ((<$>), (<*>))
28+import Control.Arrow (second)
29−import Control.Arrow (first, second)
30import Control.Monad (replicateM, forM)
29import Control.Monad (replicateM, forM)
32import qualified Data.Map as M
31import qualified Data.Map as M
@@ -136,20 +135,18 @@ valueToJs _ _ _ _ = error "Invalid argument to valueToJs"
136-- Shallow copy an object.
135-- Shallow copy an object.
138extendObj :: JS -> [(String, JS)] -> JS
137extendObj :: JS -> [(String, JS)] -> JS
139−extendObj obj sts = iife
138+extendObj obj sts = JSApp (JSFunction Nothing [] block) []
141− iife = JSApp fun []
140+ [newObj, key] = take 2 . map identToJs . unusedNames $ (obj, sts)
142− fun = JSFunction Nothing [] block
141+ jsKey = JSVar key
142+ jsNewObj = JSVar newObj
143− block = JSBlock ([objAssign, copy] ++ extensions ++ ret)
143+ block = JSBlock (objAssign:copy:extend ++ [JSReturn jsNewObj])
144 objAssign = JSVariableIntroduction newObj (Just $ JSObjectLiteral [])
144 objAssign = JSVariableIntroduction newObj (Just $ JSObjectLiteral [])
145− copy = JSForIn key obj test
146− (newObj, key) = runGen ["newObj", "key"] ((,) <$> fresh <*> fresh)
147− --(newObj, key) = runGen (map identToJs (unusedNames block)) ((,) <$> fresh <*> fresh)
148− test = JSBlock [JSIfElse cond assign Nothing]
145+ copy = JSForIn key obj $ JSBlock [JSIfElse cond assign Nothing]
149− cond = JSApp (JSAccessor "hasOwnProperty" obj) [JSVar key]
146+ cond = JSApp (JSAccessor "hasOwnProperty" obj) [jsKey]
150− assign = JSBlock [JSAssignment (JSIndexer (JSVar key) (JSVar newObj)) (JSIndexer (JSVar key) obj)]
147+ assign = JSBlock [JSAssignment (JSIndexer jsKey jsNewObj) (JSIndexer jsKey obj)]
151− extensions = map (uncurry JSAssignment . first (`JSAccessor` JSVar newObj)) sts
148+ stToAssign (s, js) = JSAssignment (JSAccessor s jsNewObj) js
152− ret = [JSReturn (JSVar newObj)]
149+ extend = map stToAssign sts
155-- Temporarily extends the environment with a single local variable name
152-- Temporarily extends the environment with a single local variable name