{- |
    Module      :  $Header$
    Description :  Code transformations
    Copyright   :  (c) 2011, Björn Peemöller (bjp@informatik.uni-kiel.de)
    License     :  BSD-3-clause

    Maintainer  :  bjp@informatik.uni-kiel.de
    Stability   :  experimental
    Portability :  portable

    This module subsumes the different transformations of the source code.
-}
module Transformations where

import Curry.Syntax

import Base.Types

import Transformations.CaseCompletion as CC (completeCase)
import Transformations.CurryToIL      as IL (ilTrans, transType)
import Transformations.Derive         as DV (derive)
import Transformations.Desugar        as DS (desugar)
import Transformations.Dictionary     as DI (insertDicts)
import Transformations.Lift           as L  (lift)
import Transformations.Newtypes       as NT (removeNewtypes)
import Transformations.Qual           as Q  (qual)
import Transformations.Simplify       as S  (simplify)

import CompilerEnv
import Imports (qualifyEnv)
import qualified IL

-- |Fully qualify used constructors and functions.
qual :: CompEnv (Module a) -> CompEnv (Module a)
qual :: CompEnv (Module a) -> CompEnv (Module a)
qual (env :: CompilerEnv
env, mdl :: Module a
mdl) = (CompilerEnv -> CompilerEnv
qualifyEnv CompilerEnv
env, Module a
mdl')
  where mdl' :: Module a
mdl' = ModuleIdent -> TCEnv -> ValueEnv -> Module a -> Module a
forall a. ModuleIdent -> TCEnv -> ValueEnv -> Module a -> Module a
Q.qual (CompilerEnv -> ModuleIdent
moduleIdent CompilerEnv
env) (CompilerEnv -> TCEnv
tyConsEnv CompilerEnv
env) (CompilerEnv -> ValueEnv
valueEnv CompilerEnv
env) Module a
mdl

-- |Automatically derive instances.
derive :: CompEnv (Module PredType) -> CompEnv (Module PredType)
derive :: CompEnv (Module PredType) -> CompEnv (Module PredType)
derive (env :: CompilerEnv
env, mdl :: Module PredType
mdl) = (CompilerEnv
env, Module PredType
mdl')
  where mdl' :: Module PredType
mdl' = TCEnv
-> ValueEnv
-> InstEnv
-> OpPrecEnv
-> Module PredType
-> Module PredType
DV.derive (CompilerEnv -> TCEnv
tyConsEnv CompilerEnv
env) (CompilerEnv -> ValueEnv
valueEnv CompilerEnv
env) (CompilerEnv -> InstEnv
instEnv CompilerEnv
env)
                         (CompilerEnv -> OpPrecEnv
opPrecEnv CompilerEnv
env) Module PredType
mdl

-- |Remove any syntactic sugar, changes the value environment.
desugar :: CompEnv (Module PredType) -> CompEnv (Module PredType)
desugar :: CompEnv (Module PredType) -> CompEnv (Module PredType)
desugar (env :: CompilerEnv
env, mdl :: Module PredType
mdl) = (CompilerEnv
env { valueEnv :: ValueEnv
valueEnv = ValueEnv
tyEnv' }, Module PredType
mdl')
  where (mdl' :: Module PredType
mdl', tyEnv' :: ValueEnv
tyEnv') = [KnownExtension]
-> ValueEnv
-> TCEnv
-> Module PredType
-> (Module PredType, ValueEnv)
DS.desugar (CompilerEnv -> [KnownExtension]
extensions CompilerEnv
env) (CompilerEnv -> ValueEnv
valueEnv CompilerEnv
env)
                                    (CompilerEnv -> TCEnv
tyConsEnv CompilerEnv
env) Module PredType
mdl

-- |Insert dictionaries, changes the type constructor and value environments.
insertDicts :: CompEnv (Module PredType) -> CompEnv (Module Type)
insertDicts :: CompEnv (Module PredType) -> CompEnv (Module Type)
insertDicts (env :: CompilerEnv
env, mdl :: Module PredType
mdl) = (CompilerEnv
env { interfaceEnv :: InterfaceEnv
interfaceEnv = InterfaceEnv
intfEnv'
                              , tyConsEnv :: TCEnv
tyConsEnv = TCEnv
tcEnv'
                              , valueEnv :: ValueEnv
valueEnv = ValueEnv
vEnv'
                              , opPrecEnv :: OpPrecEnv
opPrecEnv = OpPrecEnv
pEnv' }, Module Type
mdl')
  where (mdl' :: Module Type
mdl', intfEnv' :: InterfaceEnv
intfEnv', tcEnv' :: TCEnv
tcEnv', vEnv' :: ValueEnv
vEnv', pEnv' :: OpPrecEnv
pEnv') =
          InterfaceEnv
-> TCEnv
-> ValueEnv
-> ClassEnv
-> InstEnv
-> OpPrecEnv
-> Module PredType
-> (Module Type, InterfaceEnv, TCEnv, ValueEnv, OpPrecEnv)
DI.insertDicts (CompilerEnv -> InterfaceEnv
interfaceEnv CompilerEnv
env) (CompilerEnv -> TCEnv
tyConsEnv CompilerEnv
env) (CompilerEnv -> ValueEnv
valueEnv CompilerEnv
env)
                         (CompilerEnv -> ClassEnv
classEnv CompilerEnv
env) (CompilerEnv -> InstEnv
instEnv CompilerEnv
env) (CompilerEnv -> OpPrecEnv
opPrecEnv CompilerEnv
env) Module PredType
mdl

-- |Remove newtype constructors.
removeNewtypes :: CompEnv (Module Type) -> CompEnv (Module Type)
removeNewtypes :: CompEnv (Module Type) -> CompEnv (Module Type)
removeNewtypes (env :: CompilerEnv
env, mdl :: Module Type
mdl) = (CompilerEnv
env, Module Type
mdl')
  where mdl' :: Module Type
mdl' = ValueEnv -> Module Type -> Module Type
NT.removeNewtypes (CompilerEnv -> ValueEnv
valueEnv CompilerEnv
env) Module Type
mdl

-- |Simplify the source code, changes the value environment.
simplify :: CompEnv (Module Type) -> CompEnv (Module Type)
simplify :: CompEnv (Module Type) -> CompEnv (Module Type)
simplify (env :: CompilerEnv
env, mdl :: Module Type
mdl) = (CompilerEnv
env { valueEnv :: ValueEnv
valueEnv = ValueEnv
tyEnv' }, Module Type
mdl')
  where (mdl' :: Module Type
mdl', tyEnv' :: ValueEnv
tyEnv') = ValueEnv -> Module Type -> (Module Type, ValueEnv)
S.simplify (CompilerEnv -> ValueEnv
valueEnv CompilerEnv
env) Module Type
mdl

-- |Lift local declarations, changes the value environment.
lift :: CompEnv (Module Type) -> CompEnv (Module Type)
lift :: CompEnv (Module Type) -> CompEnv (Module Type)
lift (env :: CompilerEnv
env, mdl :: Module Type
mdl) = (CompilerEnv
env { valueEnv :: ValueEnv
valueEnv = ValueEnv
tyEnv' }, Module Type
mdl')
  where (mdl' :: Module Type
mdl', tyEnv' :: ValueEnv
tyEnv') = ValueEnv -> Module Type -> (Module Type, ValueEnv)
L.lift (CompilerEnv -> ValueEnv
valueEnv CompilerEnv
env) Module Type
mdl

-- |Translate into the intermediate language
ilTrans :: CompEnv (Module Type) -> CompEnv IL.Module
ilTrans :: CompEnv (Module Type) -> CompEnv Module
ilTrans (env :: CompilerEnv
env, mdl :: Module Type
mdl) = (CompilerEnv
env, Module
il)
  where il :: Module
il = ValueEnv -> Module Type -> Module
IL.ilTrans (CompilerEnv -> ValueEnv
valueEnv CompilerEnv
env) Module Type
mdl

-- |Translate a type into its representation in the intermediate language
transType :: Type -> IL.Type
transType :: Type -> Type
transType = Type -> Type
IL.transType

-- |Add missing case branches
completeCase :: CompEnv IL.Module -> CompEnv IL.Module
completeCase :: CompEnv Module -> CompEnv Module
completeCase (env :: CompilerEnv
env, mdl :: Module
mdl) = (CompilerEnv
env, InterfaceEnv -> Module -> Module
CC.completeCase (CompilerEnv -> InterfaceEnv
interfaceEnv CompilerEnv
env) Module
mdl)