{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE OverloadedStrings #-}
module AST.Utils.Type
  ( delambda
  , dealias
  , deepDealias
  , iteratedDealias
  )
  where


import qualified Data.Map as Map
import qualified Data.Name as Name

import AST.Canonical (Type(..), AliasType(..), FieldType(..))



-- DELAMBDA


delambda :: Type -> [Type]
delambda tipe =
  case tipe of
    TLambda arg result ->
      arg : delambda result

    _ ->
      [tipe]



-- DEALIAS


dealias :: [(Name.Name, Type)] -> AliasType -> Type
dealias args aliasType =
  case aliasType of
    Holey tipe ->
      dealiasHelp (Map.fromList args) tipe

    Filled tipe ->
      tipe


dealiasHelp :: Map.Map Name.Name Type -> Type -> Type
dealiasHelp typeTable tipe =
  case tipe of
    TLambda a b ->
      TLambda
        (dealiasHelp typeTable a)
        (dealiasHelp typeTable b)

    TVar x ->
      Map.findWithDefault tipe x typeTable

    TRecord fields ext ->
      TRecord (Map.map (dealiasField typeTable) fields) ext

    TAlias home name args t' ->
      TAlias home name (map (fmap (dealiasHelp typeTable)) args) t'

    TType home name args ->
      TType home name (map (dealiasHelp typeTable) args)

    TUnit ->
      TUnit

    TTuple a b maybeC ->
      TTuple
        (dealiasHelp typeTable a)
        (dealiasHelp typeTable b)
        (fmap (dealiasHelp typeTable) maybeC)


dealiasField :: Map.Map Name.Name Type -> FieldType -> FieldType
dealiasField typeTable (FieldType index tipe) =
  FieldType index (dealiasHelp typeTable tipe)



-- DEEP DEALIAS


deepDealias :: Type -> Type
deepDealias tipe =
  case tipe of
    TLambda a b ->
      TLambda (deepDealias a) (deepDealias b)

    TVar _ ->
      tipe

    TRecord fields ext ->
      TRecord (Map.map deepDealiasField fields) ext

    TAlias _ _ args tipe' ->
      deepDealias (dealias args tipe')

    TType home name args ->
      TType home name (map deepDealias args)

    TUnit ->
      TUnit

    TTuple a b c ->
      TTuple (deepDealias a) (deepDealias b) (fmap deepDealias c)


deepDealiasField :: FieldType -> FieldType
deepDealiasField (FieldType index tipe) =
  FieldType index (deepDealias tipe)



-- ITERATED DEALIAS


iteratedDealias :: Type -> Type
iteratedDealias tipe =
  case tipe of
    TAlias _ _ args realType ->
      iteratedDealias (dealias args realType)

    _ ->
      tipe
