gidl/src/Gidl/Interface.hs

module Gidl.Interface
  ( module Gidl.Interface.AST
  , InterfaceDescr
  , InterfaceRepr(..)
  , interfaceDescrToRepr
  , lookupInterface
  , insertInterface
  , interfaceParents
  , interfaceTypes
  , interfaceMethods
  ) where

import Data.List (nub)
import Data.Maybe (fromJust)
import Gidl.Interface.AST
import Gidl.Types

type InterfaceDescr = Interface InterfaceName TypeName

lookupInterface :: InterfaceName -> InterfaceEnv -> Maybe InterfaceDescr
lookupInterface iname (InterfaceEnv ie) = lookup iname ie

insertInterface :: InterfaceName -> InterfaceDescr -> InterfaceEnv -> InterfaceEnv
insertInterface iname i e@(InterfaceEnv ie) = case lookupInterface iname e of
  Nothing -> InterfaceEnv ((iname,i):ie)
  Just _ -> error ("insertInterface invariant broken: interface " ++ iname ++ "already exists")

interfaceParents :: Interface i t -> [i]
interfaceParents (Interface parents _) = parents

interfaceTypes :: InterfaceRepr -> [TypeRepr]
interfaceTypes ir = nub (map (methodT . snd) ms)
  where
  ms = interfaceMethods ir
  methodT :: Method TypeRepr -> TypeRepr
  methodT (AttrMethod _ tr) = tr
  methodT (StreamMethod _ tr) = tr


data InterfaceRepr = InterfaceRepr InterfaceName (Interface InterfaceRepr TypeRepr)
                     deriving (Eq, Show)

interfaceDescrToRepr :: InterfaceName -> InterfaceEnv -> TypeEnv -> InterfaceRepr
interfaceDescrToRepr iname ie te = InterfaceRepr iname ir
  where
  ir = case fromJust $ lookupInterface iname ie of
      Interface is ms -> Interface (map recur is)
                           [ (mn, methodDescrToRepr te md) | (mn, md) <- ms ]
  recur i = interfaceDescrToRepr i ie te


methodDescrToRepr :: TypeEnv -> Method TypeName -> Method TypeRepr
methodDescrToRepr te (AttrMethod p tn) = AttrMethod p (typeDescrToRepr tn te)
methodDescrToRepr te (StreamMethod r tn) = StreamMethod r (typeDescrToRepr tn te)

interfaceMethods :: InterfaceRepr -> [(MethodName, Method TypeRepr)]
interfaceMethods ir = ms ++ concatMap interfaceMethods ps
  where
  (InterfaceRepr _ (Interface ps ms)) =  ir