hic-0.0.0.1: src/Language/Cimple/Hic/Inference/Context.hs

{-# LANGUAGE OverloadedStrings #-}
module Language.Cimple.Hic.Inference.Context
    ( collectContext
    ) where

import           Data.Fix                            (Fix (..))
import           Data.Map.Strict                     (Map)
import qualified Data.Map.Strict                     as Map
import           Data.Text                           (Text)
import qualified Language.Cimple                     as C
import qualified Language.Cimple.Analysis.TypeSystem as TS
import           Language.Cimple.Hic.Context         (Context (..))
import qualified Language.Cimple.Program             as Program

collectContext :: Program.Program Text -> Context
collectContext prog =
    let tus = Program.toList prog
        typeSystem = TS.collect tus
        ctx = foldl (flip collectFile) (initialContext { ctxTypeSystem = typeSystem }) tus
    in ctx
  where
    initialContext = Context Map.empty Map.empty Map.empty Map.empty Map.empty

    collectFile (_, nodes) ctx = foldl (flip collectNode) ctx nodes

    collectNode (Fix node) ctx =
        let ctx' = case node of
                C.EnumDecl name members _ ->
                    ctx { ctxEnums = Map.insert (C.lexemeText name) (map extractEnumMember members) (ctxEnums ctx) }
                C.Union name members ->
                    ctx { ctxUnions = Map.insert (C.lexemeText name) (map extractMemberName members) (ctxUnions ctx) }
                C.Struct name members ->
                    ctx { ctxUnions = Map.insert (C.lexemeText name) (map extractMemberName members) (ctxUnions ctx) }
                C.Typedef ty name ->
                    ctx { ctxTypedefs = Map.insert (C.lexemeText name) ty (ctxTypedefs ctx) }
                _ -> ctx
        in foldl (flip collectNode) ctx' node

    extractEnumMember (Fix (C.Enumerator name _)) = C.lexemeText name
    extractEnumMember _                           = ""

    extractMemberName (Fix node) = case node of
        C.MemberDecl (Fix (C.VarDecl _ name _)) Nothing ->
            C.lexemeText name
        _ -> ""