module Data.BAByNF.Core.RefDict
    ( RefDict (..)
    , lookup
    , lookup1
    ) where

import Prelude hiding (lookup)

import Data.BAByNF.Core.Ref (Ref)
import Data.BAByNF.Core.Ref qualified as Ref

data RefDict a b where RefDict :: (Ref a) => [(a, b)] -> RefDict a b
deriving instance (Show a, Show b) => Show (RefDict a b)

lookup :: a -> RefDict a b -> [b]
lookup :: forall a b. a -> RefDict a b -> [b]
lookup a
ref (RefDict [(a, b)]
list) = a -> [(a, b)] -> [b]
forall {a} {a}. Ref a => a -> [(a, a)] -> [a]
lookup' a
ref [(a, b)]
list
    where lookup' :: a -> [(a, a)] -> [a]
lookup' a
r [(a, a)]
l = case [(a, a)]
l of
            [] -> []
            (a
r', a
e) : [(a, a)]
rest ->
                let cont :: [a]
cont = a -> [(a, a)] -> [a]
lookup' a
r [(a, a)]
rest
                    in if a -> a -> Bool
forall a. Ref a => a -> a -> Bool
Ref.eq a
r a
r' 
                    then a
e a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
cont
                    else [a]
cont

lookup1 :: a -> RefDict a b -> Maybe b
lookup1 :: forall a b. a -> RefDict a b -> Maybe b
lookup1 a
ref (RefDict [(a, b)]
list) = a -> [(a, b)] -> Maybe b
forall {a}. a -> [(a, a)] -> Maybe a
lookup1' a
ref [(a, b)]
list
    where lookup1' :: a -> [(a, a)] -> Maybe a
lookup1' a
r [(a, a)]
l = case [(a, a)]
l of
            [] -> Maybe a
forall a. Maybe a
Nothing
            (a
r', a
e) : [(a, a)]
rest ->
                if a -> a -> Bool
forall a. Ref a => a -> a -> Bool
Ref.eq a
r a
r'
                    then a -> Maybe a
forall a. a -> Maybe a
Just a
e
                    else a -> [(a, a)] -> Maybe a
lookup1' a
ref [(a, a)]
rest