{-# LANGUAGE EmptyDataDecls, TypeFamilies #-}

module Feldspar.Compiler.Backend.C.Plugin.TypeDefinitionGenerator where

import Data.List
import Feldspar.Transformation
import Feldspar.Compiler.Backend.C.CodeGeneration
import Feldspar.Compiler.Backend.C.Options
import Feldspar.Compiler.Error

import Debug.Trace

-- ===========================================================================
--  == Type definition generator plugin
-- ===========================================================================

typeDefGenError = handleError "PluginArch/TypeDefinitionGenerator"

data TypeDefinitionGenerator = TypeDefinitionGenerator

getTypes :: Options -> Type -> [Definition ()]
getTypes options typ = {-trace ("DEBUG: "show typ) $-} case typ of
    StructType members -> concatMap (getTypes options . snd) members
                       ++ [Struct {
                               structName      = toC options Declaration_pl (StructType members),
                               structMembers   = map (\(name,typ) -> StructMember name typ ()) members,
                               structLabel     = (),
                               definitionLabel = ()
                          }]
    UnionType members -> concatMap (getTypes options . snd) members
                       ++ [Union {
                               unionName       = toC options Declaration_pl (UnionType members),
                               unionMembers    = map (\(name,typ) -> UnionMember name typ ()) members,
                               unionLabel      = (),
                               definitionLabel = ()
                          }]
    ArrayType len baseType -> getTypes options baseType
    _ -> []
    -- XXX complexType?

instance Transformation TypeDefinitionGenerator where
    type From TypeDefinitionGenerator = ()
    type To TypeDefinitionGenerator = ()
    type Down TypeDefinitionGenerator = Options
    type Up TypeDefinitionGenerator = ()
    type State TypeDefinitionGenerator = [Definition ()]

instance Transformable TypeDefinitionGenerator Module where
    transform selfpointer origState fromAbove origModule = defaultTransformationResult {
        result = (result defaultTransformationResult) {
            definitions = (nub $ state defaultTransformationResult)
                       ++ (definitions $ result defaultTransformationResult)
        }
    } where
        defaultTransformationResult = defaultTransform selfpointer origState fromAbove origModule

instance Transformable TypeDefinitionGenerator Variable where
    transform selfpointer origState fromAbove origVariable = defaultTransformationResult {
        state = state defaultTransformationResult ++ getTypes fromAbove (varType origVariable)
    } where
        defaultTransformationResult = defaultTransform selfpointer origState fromAbove origVariable

instance Plugin TypeDefinitionGenerator where
    type ExternalInfo TypeDefinitionGenerator = Options
    executePlugin TypeDefinitionGenerator externalInfo procedure = result
        $ transform TypeDefinitionGenerator [{-state-}] externalInfo procedure