@@ -175,23 +175,26 @@ toJS' (C txt span expr) =
175 Case e cases -> caseToJS span e cases
175 Case e cases -> caseToJS span e cases
176 _ -> toJS expr
176 _ -> toJS expr
178−recordToJS e cmds =
178+recordToJS e loop cmds =
179 do e' <- toJS' e
179 do e' <- toJS' e
180− return $ jsFunc "" (concat [ assign "r" ("Object.create" ++ parens e')
180+ return $ jsFunc "" (concat [ assign "r" "{}"
182+ , "\nfor(var i in e){", loop, "}"
182 , ret "r" ]) ++ "()"
184 , ret "r" ]) ++ "()"
186+remove x = concat [ "\n if (i!='", x, "') { r[i]=e[i]; }"
187+ , "\n else if (e[i].length>1) { r[i]=e[i].slice(1); }" ]
184addField (x,e) = ((++add) . assign "v") `liftM` toJS' e
188addField (x,e) = ((++add) . assign "v") `liftM` toJS' e
185 where add = concat [ "\n r.", x, " = '", x, "' in r ? [v].concat(r.", x, ") : [v];" ]
189 where add = concat [ "\n r.", x, " = '", x, "' in r ? [v].concat(r.", x, ") : [v];" ]
186−setField (x,e) = do
190+setField (x,e) = let rx = "r." ++ x in
188− set <- globalAssign (rx ++ "[0]") `liftM` toJS' e
191+ do set <- globalAssign (rx ++ "[0]") `liftM` toJS' e
189− return (globalAssign rx (rx ++ ".slice(0)") ++ set)
192+ return (globalAssign rx (rx ++ ".slice(0)") ++ set)
190access x e = jsFunc "r" (ret body) ++ parens e
193access x e = jsFunc "r" (ret body) ++ parens e
191 where body = "'_' in r ? r." ++ x ++ "[0] : r." ++ x
194 where body = "'_' in r ? r." ++ x ++ "[0] : r." ++ x
192makeRecord kvs = do
195makeRecord kvs = do
193 kvs' <- (Map.toList . foldl' combine Map.empty) `liftM` mapM prep kvs
196 kvs' <- (Map.toList . foldl' combine Map.empty) `liftM` mapM prep kvs
194− let fs = map (\(k,vs) -> k ++ " : " ++ jsList vs) kvs' ++ ["_ : [true]"]
197+ let fs = map (\(k,vs) -> k ++ " : " ++ jsList vs) kvs' ++ ["_ : true"]
195 return $ braces ("\n " ++ intercalate ",\n " fs)
198 return $ braces ("\n " ++ intercalate ",\n " fs)
196 where combine r (k,v) = Map.insertWith (++) k v r
199 where combine r (k,v) = Map.insertWith (++) k v r
197 prep (k, as, e@(C t s _)) =
200 prep (k, as, e@(C t s _)) =
@@ -210,9 +213,9 @@ instance ToJS Expr where
210 Boolean b -> return $ if b then "true" else "false"
213 Boolean b -> return $ if b then "true" else "false"
211 Range lo hi -> jsRange `liftM` toJS' lo `ap` toJS' hi
214 Range lo hi -> jsRange `liftM` toJS' lo `ap` toJS' hi
212 Access e x -> access x `liftM` toJS' e
215 Access e x -> access x `liftM` toJS' e
213− Remove e x -> recordToJS e ("\ndelete r." ++ x ++ ";")
216+ Remove e x -> recordToJS e (remove x) ""
214− Insert e x v -> recordToJS e =<< addField (x,v)
217+ Insert e x v -> recordToJS e "r[i]=e[i];" =<< addField (x,v)
215− Modify e fs -> recordToJS e . concat =<< mapM setField fs
218+ Modify e fs -> recordToJS e "r[i]=e[i];" . concat =<< mapM setField fs
216 Record fs -> makeRecord fs
219 Record fs -> makeRecord fs
217 Binop op e1 e2 -> binop op `liftM` toJS' e1 `ap` toJS' e2
220 Binop op e1 e2 -> binop op `liftM` toJS' e1 `ap` toJS' e2