Switching.hs

{-# LANGUAGE ExistentialQuantification #-}

import Control.Applicative
import qualified Data.Vector as V

data Tree a = Node (V.Vector (Tree a))
            | Leaf a
            deriving Show

class Switchable c where
        getIndex :: c -> Int

data SwitchData = forall c. Switchable c => SwitchData c

switch :: SwitchData -> Tree a -> Tree a
switch (SwitchData c) (Node vec) = vec `V.unsafeIndex` getIndex c
switch _ _ = error "switch: performing switch on a Leaf of context tree"

switchOnData :: [SwitchData] -> Tree a -> a
switchOnData (x:xs) tree = switchOnData xs $ switch x tree
switchOnData [] (Leaf c) = c
switchOnData [] (Node _) = error "switchOnData: partial data"

data Sign = P | M
instance Switchable Sign where
    getIndex P = 0
    getIndex M = 1

signTree :: Tree Char
signTree = Node (V.fromList [Node (V.fromList [(Leaf 'a')
                                              ,(Leaf 'b')])
                            ,Node (V.fromList [(Leaf 'c')
                                              ,(Leaf 'd')])])

testSwitch :: IO ()
testSwitch = print $ switchOnData [SwitchData P, SwitchData M] signTree

main :: IO ()
main = testSwitch