~jojo/Carth

ref: 749208029494a7c48ce04444a513424f4b998416 Carth/src/Selections.hs -rw-r--r-- 1.5 KiB
74920802JoJo update TODO 6 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
module Selections (Select (..), Selections, newSelections, select, selectVarBindings) where

import qualified Data.Map as Map
import Data.Map (Map)
import Data.Word
import Control.Monad

import Misc
import Optimized

type Selections a = Map Access a

class Select m a where
    selectAs :: Span -> [Type] -> a -> m a
    selectSub :: Span -> Word32 -> a -> m a
    selectDeref :: a -> m a

newSelections :: a -> Selections a
newSelections x = Map.singleton Obj x

select :: (Monad m, Select m a) => Access -> Selections a -> m (a, Selections a)
select selector selections = case Map.lookup selector selections of
    Just a -> pure (a, selections)
    Nothing -> do
        (a, selections') <- case selector of
            Obj -> ice "select: Obj not in selections"
            As x span' ts -> do
                (a', s') <- select x selections
                a'' <- selectAs span' ts a'
                pure (a'', s')
            Sel i span' x -> do
                (a', s') <- select x selections
                a'' <- selectSub span' i a'
                pure (a'', s')
            ADeref x -> do
                (a', s') <- select x selections
                a'' <- selectDeref a'
                pure (a'', s')
        pure (a, Map.insert selector a selections')

selectVarBindings
    :: (Monad m, Select m a) => Selections a -> VarBindings -> m [(TypedVar, a)]
selectVarBindings selections = fmap fst . foldM
    (\(bs', ss) (x, s) -> do
        (a, ss') <- select s ss
        pure ((x, a) : bs', ss')
    )
    ([], selections)