~jojo/Carth

ref: 3f71c019bc3fd13360c650cd69e5e211660db158 Carth/src/Selections.hs -rw-r--r-- 1.5 KiB
3f71c019JoJo Delay StartNotDefined error until after typechecking 1 year, 10 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
49
50
51
52
53
54
{-# LANGUAGE LambdaCase, TupleSections #-}

module Selections (Selections, newSelections, select, selectVarBindings) where

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

import Misc
import MonoAst


type Selections a = Map Access a


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

select
    :: (Show a, Monad m)
    => (Span -> [Type] -> a -> m a)
    -> (Span -> Word32 -> a -> m a)
    -> Access
    -> Selections a
    -> m (a, Selections a)
select conv sub 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 conv sub x selections
                a'' <- conv span' ts a'
                pure (a'', s')
            Sel i span' x -> do
                (a', s') <- select conv sub x selections
                a'' <- sub span' i a'
                pure (a'', s')
        pure (a, Map.insert selector a selections')

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