| 1335 | | |
| 1336 | | -- XXX These bulks of code below screams for refactoring |
| 1337 | | |
| 1338 | | pairsFromRef :: VRef -> Eval [Val] |
| 1339 | | pairsFromRef r@(MkRef (IPair _)) = do |
| 1340 | | return [VRef r] |
| 1341 | | pairsFromRef (MkRef (IHash hv)) = do |
| 1342 | | keys <- hash_fetchKeys hv |
| 1343 | | elems <- mapM (hash_fetchElem hv) keys |
| 1344 | | return $ map (VRef . MkRef . IPair) (keys `zip` elems) |
| 1345 | | pairsFromRef (MkRef (IArray av)) = do |
| 1346 | | vals <- array_fetch av |
| 1347 | | return $ map castV ((map VInt [0..]) `zip` vals) |
| 1348 | | pairsFromRef (MkRef (IScalar sv)) = do |
| 1349 | | refVal <- scalar_fetch sv |
| 1350 | | op1Pairs refVal |
| 1351 | | pairsFromRef ref = retError "Not a keyed reference" ref |
| 1352 | | |
| 1353 | | keysFromRef :: VRef -> Eval [Val] |
| 1354 | | keysFromRef (MkRef (IPair pv)) = do |
| 1355 | | key <- pair_fetchKey pv |
| 1356 | | return [key] |
| 1357 | | keysFromRef (MkRef (IHash hv)) = do |
| 1358 | | keys <- hash_fetchKeys hv |
| 1359 | | return $ map castV keys |
| 1360 | | keysFromRef (MkRef (IArray av)) = do |
| 1361 | | keys <- array_fetchKeys av |
| 1362 | | return $ map castV keys |
| 1363 | | keysFromRef (MkRef (IScalar sv)) = do |
| 1364 | | refVal <- scalar_fetch sv |
| 1365 | | if defined refVal |
| 1366 | | then fromVal =<< op1Keys refVal |
| 1367 | | else return [] |
| 1368 | | keysFromRef ref = retError "Not a keyed reference" ref |
| 1369 | | |
| 1370 | | valuesFromRef :: VRef -> Eval [Val] |
| 1371 | | valuesFromRef (MkRef (IPair pv)) = do |
| 1372 | | val <- pair_fetchVal pv |
| 1373 | | return [val] |
| 1374 | | valuesFromRef (MkRef (IHash hv)) = do |
| 1375 | | pairs <- hash_fetch hv |
| 1376 | | return $ Map.elems pairs |
| 1377 | | valuesFromRef (MkRef (IArray av)) = array_fetch av |
| 1378 | | valuesFromRef (MkRef (IScalar sv)) = do |
| 1379 | | refVal <- scalar_fetch sv |
| 1380 | | if defined refVal |
| 1381 | | then fromVal =<< op1Values refVal |
| 1382 | | else return [] |
| 1383 | | valuesFromRef ref = retError "Not a keyed reference" ref |
| 1384 | | |
| 1385 | | existsFromRef :: VRef -> Val -> Eval VBool |
| 1386 | | existsFromRef (MkRef (IHash hv)) val = do |
| 1387 | | idx <- fromVal val |
| 1388 | | hash_existsElem hv idx |
| 1389 | | existsFromRef (MkRef (IArray av)) val = do |
| 1390 | | idx <- fromVal val |
| 1391 | | array_existsElem av idx |
| 1392 | | existsFromRef (MkRef (IScalar sv)) val = do |
| 1393 | | refVal <- scalar_fetch sv |
| 1394 | | ref <- fromVal refVal |
| 1395 | | existsFromRef ref val |
| 1396 | | existsFromRef ref _ = retError "Not a keyed reference" ref |
| 1397 | | |
| 1398 | | deleteFromRef :: VRef -> Val -> Eval Val |
| 1399 | | deleteFromRef (MkRef (IHash hv)) val = do |
| 1400 | | idxs <- fromVals val |
| 1401 | | rv <- forM idxs $ \idx -> do |
| 1402 | | val <- hash_fetchVal hv idx |
| 1403 | | hash_deleteElem hv idx |
| 1404 | | return val |
| 1405 | | return $ VList rv |
| 1406 | | deleteFromRef (MkRef (IArray av)) val = do |
| 1407 | | idxs <- fromVals val |
| 1408 | | rv <- forM idxs $ \idx -> do |
| 1409 | | val <- array_fetchVal av idx |
| 1410 | | array_deleteElem av idx |
| 1411 | | return val |
| 1412 | | return $ VList rv |
| 1413 | | deleteFromRef (MkRef (IScalar sv)) val = do |
| 1414 | | refVal <- scalar_fetch sv |
| 1415 | | ref <- fromVal refVal |
| 1416 | | deleteFromRef ref val |
| 1417 | | deleteFromRef ref _ = retError "Not a keyed reference" ref |