packages feed

descript-lang-0.2.0.0: src/Descript/BasicInj/Read/Resolve/Subst/Local.hs

{-# LANGUAGE TypeFamilies #-}

module Descript.BasicInj.Read.Resolve.Subst.Local
  ( localSubstMany
  ) where

import Descript.BasicInj.Read.Resolve.Subst.Subst
import qualified Descript.BasicInj.Traverse.Term as T
import Descript.BasicInj.Traverse
import Descript.BasicInj.Data
import Descript.Misc
import Core.Data.List.Assoc

newtype LocalSubstMany an = LocalSubstMany [Subst]

instance (TaintAnn an) => Mapping (LocalSubstMany an) where
  type MAnn (LocalSubstMany an) = an

  monTerm T.RecordHead (LocalSubstMany substs) x
    = localSubstManyIndiv substs x
  monTerm _ _ x = x

-- | Locally applies each substitution by directly substituting
-- occurrences of the symbol.
localSubstMany :: (TaintAnn an)
               => [Subst]
               -> AModule an
               -> AModule an
localSubstMany = mapTerm T.AModule . LocalSubstMany

localSubstManyIndiv :: (TaintAnn an)
                    => [Subst]
                    -> FSymbol an
                    -> FSymbol an
localSubstManyIndiv substs x
  = case glookup x_ substs of
         Nothing -> x
         Just y_ -> y
           where y = ann' <$ y_
  where x_ = remAnns x
        ann' = getAnn x