@@ -25,7 +25,8 @@ module Language.PureScript.CodeGen.JS (
2525import Data.Maybe (fromMaybe, mapMaybe)
2626import Data.Function (on)
2727
28−import Control.Arrow (second)
28+import Control.Applicative ((<$>), (<*>))
29+import Control.Arrow (first, second)
2930import Control.Monad (replicateM, forM)
3031
3132import qualified Data.Map as M
@@ -117,7 +118,8 @@ valueToJs _ _ _ (StringLiteral s) = JSStringLiteral s
117118valueToJs _ _ _ (BooleanLiteral b) = JSBooleanLiteral b
118119valueToJs opts m e (ArrayLiteral xs) = JSArrayLiteral (map (valueToJs opts m e) xs)
119120valueToJs opts m e (ObjectLiteral ps) = JSObjectLiteral (map (second (valueToJs opts m e)) ps)
120−valueToJs opts m e (ObjectUpdate o ps) = JSApp (JSAccessor "extend" (JSVar "Object")) [ valueToJs opts m e o, JSObjectLiteral (map (second (valueToJs opts m e)) ps)]
121+valueToJs opts m e (ObjectUpdate o ps) = extendObj (valueToJs opts m e o) (map (second (valueToJs opts m e)) ps)
122+--valueToJs opts m e (ObjectUpdate o ps) = JSApp (JSAccessor "extend" (JSVar "Object")) [ valueToJs opts m e o, JSObjectLiteral (map (second (valueToJs opts m e)) ps)]
121123valueToJs _ m _ (Constructor name) = qualifiedToJS m (Ident . runProperName) name
122124valueToJs opts m e (Case values binders) = bindersToJs opts m e binders (map (valueToJs opts m e) values)
123125valueToJs opts m e (IfThenElse cond th el) = JSConditional (valueToJs opts m e cond) (valueToJs opts m e th) (valueToJs opts m e el)
@@ -130,6 +132,25 @@ valueToJs opts m e (TypedValue _ val _) = valueToJs opts m e val
130132valueToJs _ _ _ (TypeClassDictionary _ _) = error "Type class dictionary was not replaced"
131133valueToJs _ _ _ _ = error "Invalid argument to valueToJs"
132134
135+-- |
136+-- Shallow copy an object.
137+--
138+extendObj :: JS -> [(String, JS)] -> JS
139+extendObj obj sts = iife
140+ where
141+ iife = JSApp fun []
142+ fun = JSFunction Nothing [] block
143+ block = JSBlock ([objAssign, copy] ++ extensions ++ ret)
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 obj)) ((,) <$> fresh <*> fresh)
148+ test = JSBlock [JSIfElse cond assign Nothing]
149+ cond = JSApp (JSAccessor "hasOwnProperty" obj) [JSVar key]
150+ assign = JSBlock [JSAssignment (JSIndexer (JSVar key) (JSVar newObj)) (JSIndexer (JSVar key) obj)]
151+ extensions = map (uncurry JSAssignment . first ((`JSIndexer` JSVar newObj) . JSVar)) sts
152+ ret = [JSReturn (JSVar newObj)]
153+
133154-- |
134155-- Temporarily extends the environment with a single local variable name
135156--